.TITLE	DRGIN
	.IDENT	/07.01/
 
;
; Copyright (c) 1995-1999 by Mentec Inc., U.S.A.
; All rights reserved.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
; PREVIOUSLY MODIFIED BY:
;
;	JIM KAUFFMAN
;	ERIC POSTPISCHIL
;	K. L. NOEL
;
; MODIFIED FOR RSX-11M-PLUS V4.2 BY:
;
;	K.L. NOEL
;	R.D. HANEY
;	L.M. PETERSON
;	B.S. MCCARTHY
;	K. L. NOEL
;
; MODIFIED FOR RSX-11M-PLUS V4.3 BY:
;
;	J.W. BERZLE
;
; MODIFIED FOR RSX-11M-PLUS V4.5 BY:
;
;	D. CARROLL	15-JUN-1993		07.01
;
;		DC226 -- ALLOW $SFFMK TO RETURN $FMSK6 AS WELL
;

;
; LOCAL DATA
;
	GBLMSK	=	7	;SEARCH INHIBIT MASK TO ONLY SYSTEM LOGICALS
	USRMSK	=	15	;SEARCH INHIBIT MASK TO ONLY USER LOGICALS
	MAP6	=	140000	;OFFSET TO START OF APR6

;
; MACRO LIBRARY CALLS
;
	.IF DF C$$RMT		; REMOTE TASK SUPPORT

	.MCALL	CPRDF$
	CPRDF$

	.ENDC	; C$$RMT
	.PAGE
;
; DEFINE SUBFUNCTION DISPATCH TABLE ENTRY
;
; 	SFDIR	FLAGS,DPBSIZ,BUFSIZ,ADDR,COND
;
; WHERE:
;
;	FLAGS=	SF.IN SET IF THE SUBFUNCTION RETURNS SYSTEM INFORMATION.
;		SF.PRV IF THE SUBFUNCTION IS PRIVILEGED.
;		(BITS 15-13 IN THE FIRST WORD OF THE ENTRY).
;	DPBSIZ=DPB SIZE IN WORDS.
;		(BITS 12-8 IN THE FIRST WORD OF THE ENTRY).
;	BUFSIZ=SIZE OF THE MINIMUM BUFFER REQUIRED IN WORDS.
;		(BITS 7-0 IN THE FIRST WORD OF THE ENTRY).
;	ADDR=ADDRESS OF ROUTINE TO PERFORM THE FUNCTION.
;		(SECOND WORD OF THE ENTRY).
;	COND=EXPRESSION ON WHICH DIRECTIVE IS CONDITIONALIZED.
;		DEFAULT OF $SFTBL IS USED FOR CONVENIENCE (I.E.
;		UNCONDITIONAL).
;

	.MACRO	SFDIR	FLAGS,DPBSIZ,BUFSIZ,ADDR,COND=$SFTBL


	.IF DF	COND

	.WORD	FLAGS!<DPBSIZ*256.>!<BUFSIZ>
	.WORD	ADDR

	.IFF

	.WORD	0
	.WORD	0

	.ENDC


	.ENDM

	.PAGE

;+
; SUBFUNCTION DISPATCH TABLE FOR THE GET/SET INFORMATION DIRECTIVE.
;-


$SFTBL::SFDIR	SF.PRV!SF.IN, 8., 6.,$SFGAS	   ;000.-GET ASSIGNMENT INFO
	SFDIR	SF.IN,	      4., 5.,$SFUIC	   ;001.-GET SYSUIC, LIBUIC,
	SFDIR	0,	      3., 0.,$SFDEF	   ;002.-SET DEFAULT UIC
	SFDIR	SF.IN,	      4., 9.,$SFFMK	   ;003.-GET FEATURE MASK WORDS
	SFDIR	0,	      4., 2.,$SFQMC	   ;004.-QUEUE MCR COMMAND LINE
	SFDIR	0,	      6., <B.ULEN/2>,$SFUAB,A$$CNT
						   ;005.-GET USER ACCOUNT BLK
	SFDIR	SF.IN,	      6., 1.,$SFDEV	   ;006.-GET DEVICE INFORMATION
	SFDIR	0,	      3., 0.,$SFSPR	   ;007.-SET TASK PRIVILEGE
	SFDIR	0,	      4., 0.,$SFREN	   ;008.-CHANGE TASK NAME
	SFDIR	SF.IN,	      4.,97.,$SFAPR	   ;009.-READ ALL APRS
	SFDIR	SF.IN,	      6., 2.,$SFFTK	   ;010.-FIND AND GET TASK INFO
	SFDIR	0,	      10.,0,$SFPMN   	   ;011.-SET PMON PARMS
	SFDIR	0,	      4., 1.,$SFCFG	   ;012.-GET CONFIG. TAB
	SFDIR	0,	      4., 3.,$SFSSN	   ;013.-GET SYS. SERIAL
	SFDIR	0,	      4., 2.,$SFABO	   ;014.-ABORT ALL TASKS
	SFDIR	SF.IN,        4., 2.,$SFVEC	   ;015.-TRANSLATE VECTOR
	SFDIR	0,	      0., 0.,      0,NEVER ;016.-GET MASS STORAGE (P/OS)
	SFDIR	SF.IN,	      4., 5.,$SFUPD	   ;017.-UPDATE UICS
	SFDIR	SF.IN,	      6., 1.,$SFDEV	   ;018.-SON OF GET DEVICE
						   ;     INFORMATION
$SFHI==<.-$SFTBL/4-1>

;+
; **-$DRGIN-GENERAL INFORMATION DIRECTIVE
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO PERFORM THE SUBFUNCTION
; INDICATED IN THE DPB.
; THE FUNCTIONS CAN EITHER SET PARAMETERS OR GET INFORMATION.
;
;*****************************************************************
;
; CAUTION!  THIS DIRECTIVE IS INTENDED FOR USE ONLY BY
;	 DEC SOFTWARE.  THERE IS NO GUARANTEE THAT THIS
;	 DIRECTIVE WILL BE IN FUTURE RELEASES OR THAT
;	 THE FORMAT WILL REMAIN THE SAME.
;
;*****************************************************************
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(VARIABLE).
;	WD. 01 -- SUBFUNCTION CODE (LOW BYTE).
;	WD. 02 -- PARAMETER 1 (BUFFER ADDRESS).
;	WD. 03 -- PARAMETER 2 (BUFFER SIZE IN WORDS).
;	WD. N  -- PARAMETER N (MAX DPB SIZE IS 32. WORDS).
;
; INPUTS:
;
;	R2=ADDRESS OF SECOND STATUS WORD OF CURRENT TASK.
;	R3=POINTER TO WD. 1 IN THE DPB.
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 IF DIRECTIVE IS SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS99' IS RETURNED IF THE TASK
;			HAS SPECIFIED AN INVALID SUBFUNCTION CODE
;			OR THE DPB SIZE IS INVALID.
;		DIRECTIVE STATUS OF 'D.RS98' IS RETURNED IF THE USER
;			BUFFER FAILS ADDRESS CHECKS.
;		DIRECTIVE STATUS OF 'D.RS16' IS RETURNED IF THE
;			SUBFUNCTION REQUIRES PRIVILEGE AND THE REQUESTING
;			TASK IS NOT PRIVILEGED.
;
;	NOTE:	IF A USER BUFFER IS SPECIFIED, THE SERVICE ROUTINE IS
;		ENTERED WITH R3 POINTING TO THE BUFFER AND R4 POINTING
;		TO WORD 4 OF THE DPB.
;
;		IF NO USER BUFFER IS SPECIFIED, THE SERVICE ROUTINE IS
;		ENTERED WITH R3 POINTING TO WORD 2 OF THE DPB.
;
;-

	
	
	.IF DF D$$PAR

$DRGN1::

	.IFF	; DF D$$PAR

$DRGIN::

	.ENDC	; DF D$$PAR

	MOV	(R3)+,R4	;GET SUBFUNCTION CODE
	CMP	R4,#$SFHI	;CODE WITHIN RANGE?
	BHI	90$		;IF HI NO
	ASH	#2,R4		;CONVERT CODE TO DOUBLE WORD INDEX
	ADD	#$SFTBL,R4	;POINT TO PROPER TABLE ENTRY
	MOV	(R4)+,R1	;GET FLAGS AND MINIMUM BUFFER SIZE
	BEQ	90$		;IF EQ INVALID SUBFUNCTION

	.IF DF	R$$PRO

	.IFF	;R$$PRO

	BPL	10$		;IF PL NO PRIVILEGE IS REQUIRED
	BIT	#T3.PRV,T.ST3(R5) ;CURRENT TASK PRIVILEGED?
	BEQ	80$		;IF EQ NO, PRIVILEGE VIOLATION

	.IFTF	;R$$PRO

10$:	MOV	R1,R2		;COPY DPB SIZE
	SWAB	R2		;MOVE IT TO LOW BYTE
	BIC	#^C<37>,R2	;CLEAR IRRELEVANT BITS
	CMPB	R2,$DICSV+1	;CORRECT DPB SIZE?
	BNE	90$		;IF NE NO
	MOV	(R4),-(SP)	;GET SERVICE ROUTINE ADDRESS
	BIC	#177400,R1	;KEEP BUFFER SIZE
	BEQ	30$		;IF EQ NO BUFFER SPECIFIED
	MOV	(R3)+,R0	;GET USER BUFFER ADDRESS
	CMP	(R3),R1		;IS USER BUFFER LARGE ENOUGH?
	BLO	90$		;IF LO NO
	MOV	(R3),-(SP)	;SAVE NUMBER OF WORDS IN USER BUFFER
	SUB	R1,(SP)		;CALCULATE # OF EXTRA WORDS IN USER BUFFER
	MOV	(R3)+,R1	;GET SIZE OF USER BUFFER FOR ADDRESS CHECK
	ASL	R1		;CONVERT SIZE TO BYTES
	MOV	-(R4),R2	;GET FLAGS
	MOV	R3,R4		;COPY DPB ADDRESS
	MOV	R0,R3		;COPY USER BUFFER ADDR FOR ADDR CHECK
	BIT	#SF.IN,R2	;IS THIS A READ ONLY FUNCTION?
	BEQ	20$		;IF EQ YES
	CALL	$ACHKP		;ADDRESS CHECK BUFFER FOR R/W ACCESS
	BR	25$		;
20$:	CALL	$ACHRO		;ADDRESS CHECK BUFFER FOR RO ACCESS
	BCS	70$		;IF CS ADDRESS CHECK HAS FAILED
	CALL	$RELOC		;RELOCATE BUFFER ADDRESS
	MOV	R1,KISAR6	;MAP TO THE USER BUFFER
	MOV	R2,R3		;REDEFINE PARAMETER BLOCK ADDRESS
25$:	MOV	(SP)+,R2	;GET NUMBER OF EXTRA WORDS IN USER BUFFER
30$:	CALLR	@(SP)+		;DISPATCH TO THE APPROPRIATE ROUTINE
70$:	DRSTS	D.RS98		;SET DIRECTIVE STATUS

	.IFF	;R$$PRO

80$:	DRSTS	D.RS16		;PRIVILEGE VIOLATION

	.IFTF	;R$$PRO

90$:				;REF. LABLE FOR ERROR RETURN OF IE.SDP

	.IFT	;R$$PRO

$SFGAS::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFUIC::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFDEF::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFFMK::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFQMC::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFDEV::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFSPR::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFREN::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFAPR::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFFTK::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS
$SFABO::			;REF. LABEL TO NOP SUBFUNCTION ON P/OS

	.IFTF	;R$$PRO

	.IF NDF	P$$MON

$SFPMN::

	.ENDC	;P$$MON

	.IF NDF P$$3XX
$SFCFG::			;REF. LABEL TO NOP SUBFUNCTION ON M-PLUS
$SFSSN::			;REF. LABEL TO NOP SUBFUNCTION ON M-PLUS

	.ENDC ; DF P$$3XX

	DRSTS	D.RS99		;INVALID SUBFUNCTION CODE OR BUFFER

	.IFF	;R$$PRO

 
;+
; **-SFGAS-GET ASSIGNED DEVICE NAME
;
; THIS SUBFUNCTION SEARCHES THE ASSIGNMENT LIST FOR A SPECIFIED LOGICAL 
; NAME AND RETURNS THE NAME OF THE PHYSICAL DEVICE TO WHICH IT IS ASSIGNED.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(8.).
;	WD. 01 -- SUB FUNCTION CODE (0) (LOW BYTE).
;	WD. 02 -- OUTPUT BUFFER ADDRESS.
;	WD. 03 -- OUTPUT BUFFER SIZE (IN WORDS).
;	WD. 04 -- LOGICAL DEVICE NAME.
;	WD. 05 -- LOGICAL DEVICE NUMBER.
;	WD. 06 -- TI NAME FOR WHICH THIS ASSIGNMENT HOLDS. (0 FOR GLOBAL).
;	WD. 07 -- TI DEVICE NUMBER.
;		  (IF HIGH BIT OF UNIT NUMBER IS SET, GET LOGIN ASSIGN)
;
; BUFFER FORMAT:
;
;	WD. 00 -- NAME OF ASSIGNED DEVICE.
;	WD. 01 -- UNIT NUMBER OF ASSIGNED DEVICE AND FLAGS BYTE.
;	WD. 02 -- FIRST DEVICE CHARACTERISTICS WORD.
;	WD. 03 -- SECOND DEVICE CHARACTERISTICS WORD.
;	WD. 04 -- THIRD DEVICE CHARACTERISTICS WORD.
;	WD. 05. -- FOURTH DEVICE CHARACTERISTICS WORD.
;
; INPUTS:
;
;	R2=NUMBER OF EXTRA WORDS IN USER BUFFER.
;	R3=ADDRESS OF THE LOGICAL NAME IN THE BUFFER.
;	R4=ADDRESS OF WD. 04 IN THE DPB.
;	R5=ADDRESS OF THE TCB OF THE REQUESTING TASK.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 IF DIRECTIVE SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS5' IS RETURNED IF NO
;			ASSIGNMENT EXISTS FOR THE SPECIFIED LOGICAL NAME.
;		DIRECTIVE STATUS OF 'D.RS92' IS RETURNED IF SPECIFIED
;			DEVICE IS NOT A TERMINAL.
;		DIRECTIVE STATUS OF 'D.RS16' IS RETURNED IF REQUESTING 
;			TASK IS NOT PRIVILEGED.
;
;-
 
$SFGAS::

	.IF DF	L$$GCL		;EXTENDED LOGICAL NAME SUPPORT

	MOV	#GBLMSK,$TONYL	;INITIALIZE SEARCH ONLY TO SYSTEM LOGICALS

	.IFTF	;DF L$$GCL

	MOV	R3,-(SP)	;SAVE USER BUFFER ADDRESS
	CLR 	R2		;ASSUME NO TERMINAL SPECIFIED, UCB=0
	MOV	4(R4),R0	;GET TERMINAL NAME
	BEQ	10$		;IF EQ DON'T LOOK FOR TI UCB
	MOV	6(R4),R1	;GET TI DEVICE NUMBER
	BIC	#177400,R1	;STRIP OFF HIGH BYTE (LOGIN/LOCAL FLAG)
	CALL	$CVDVN		;CONVERT DEVICE NAME TO A UCB ADDRESS
	BCS	70$		;IF CS DEVICE NOT FOUND
	BIT	#DV.TTY,U.CW1(R2) ;IS IT A TERMINAL?
	BEQ	70$		;IF EQ NO

10$:
	.IF DF C$$RTK		;REMOTE DEVICE SUPPORT

	BIT	#F5.RTK,$FMSK5	;REMOTE DEVICE SUPPORT ON?
	BEQ	17$		;IF EQ NO
;
; FOR REMOTE HOST SYSTEMS, WE DO NOT ALLOW GET ASSIGNED DEVICE FOR A LOCAL
; LOGICAL NAME WHERE THE TI IS NOT OUR OWN.  THIS IS BECAUSE THE CPRAME 
; SERVICING THE REQUEST DOES NOT HAVE ACCESS TO ANOTHER AME'S LOGICALS
;
	TST	R2		;WAS THERE A TI UCB SPECIFIED
	BEQ	15$		;IF EQ NO
	CMP	R2,T.UCB(R5)	;IS THIS OUR TI?
	BNE	70$		;IF NE NO
;
; GIN$ DIRECTIVE MUST BE DONE REMOTELY
;
15$:	MOV	R4,R3		;PUT ADDRESS OF DPB IN R3
	SUB	#4,R3		;AND POINT TO WORD 2
	CLR	R2		;INDICATE NO UCB ADDRESS

	JMP	$RTINF		;JOIN COMMON CODE IN GLUN 

	.ENDC	;C$$RTK
	
17$:	TST	R2		;WAS TI UCB SPECIFIED?
	BEQ	20$		;IF EQ NO, LOOK FOR GLOBAL ASSIGNMENT

	.IFF	;DF L$$GCL

20$:	MOV	#$LOGHD,R1	;GET ADDRESS OF LOGICAL ASSIGNMENT HEAD
30$:	MOV	(R1),R1		;GET NEXT ASSIGNMENT BLOCK
	BEQ	80$		;IF EQ END OF LIST
	TST	R0		;SEARCHING FOR A GLOBAL ASSIGNMENT?
	BNE	40$		;IF NE NO
	TSTB	L.TYPE(R1)	;GLOBAL ASSIGNMENT?
	BNE	30$		;IF NE NO
	BR	50$		;SKIP UCB CHECK
40$:	CMP	L.UCB(R1),R2	;TI UCB ADDRESS MATCH?
	BNE	30$		;IF NE NO
	TSTB	7(R4)		;LOOKING FOR LOGIN ASSIGNMENT ?
	BPL	50$		;IF PL NO
	CMPB	#-1,L.TYPE(R1)	;IS THIS A LOGIN ASSIGNMENT ?
	BNE	30$		;IF NE NO
50$:	CMP	L.NAM(R1),(R4)	;DEVICE NAME MATCH?
	BNE	30$		;IF NE NO
	CMPB	L.UNIT(R1),2(R4) ;UNIT NUMBER MATCH?
	BNE	30$		;IF NE NO
	MOVB	7(R4),R2	;SAVE LOGIN ASSIGN FLAG
	MOV	L.ASG(R1),R4	;GET ASSIGNMENT UCB ADDRESS
	TST	R0		;LOOKING FOR GLOBAL ASSIGN ?
	BEQ	65$		;IF EQ YES - USE UCB AS IS
	TST	R2		;WAS IT A LOGIN ASSIGNMENT LOOKUP ?
	BPL	65$		;IF PL NO, USE "RAW" UCB ADDRESS

	.IFT	;DF L$$GCL

	BIT	#U2.LOG,U.CW2(R2) ;IS THIS TERMINAL LOGGED ON?
	BNE	80$		;IF NE, NO, THERE ARE NO LOGICALS 
	MOV	R2,R1		;GET COPY OF UCB ADDRESS
	CALL	$GTUSR		;SET UP THE USER HASH TABLE ADDRESS
	MOV	#USRMSK,$TONYL	;INITIALIZE TO INHIBIT ALL BUT USER TABLES
	MOVB	#LB.LOG,R3	;SET UP THE LOGIN MOD VALUE BY DEFAULT
	TSTB	7(R4)		;SEE IF THIS IS A LOGIN LOOKUP
	BMI	25$		;IF MI, IT IS, KEEP THE INITIALIZED VALUES
20$:	CLR	R3		;ZERO MOD VALUE TO PICK UP ANY LOGICAL
25$:	MOV	(R4),R2		;GET DEVICE MNEMONIC
	MOV	2(R4),R0	;GET UNIT NUMBER
	MOV	R4,-(SP)	;SAVE THE DPB ADDRESS ACROSS CALLS
	MOV	#$LNTSL,-(SP)	;CALL LOOKUP ROUTINE
	CALL	$MPDC3		;IN THIRD DIRECTIVE COMMON
	BCC	30$		;IF CC, SUCCESSFUL LOOKUP IN TABLE
	TST	R3		;SEE IF THERE REALLY WAS A LOGICAL
	BEQ	80$		;IF EQ, NO LOGICAL ASSOCIATED WITH NAME
	MOV	(SP)+,R4	;RESTORE THE BUFFER ADDRESS
	BR	70$		;TRANSLATION OCCURRED TO BAD DEVICE OR LOOP
30$:	MOV	(SP)+,R4	;RESTORE ADDRESS TO DPB
	MOV	R2,(R4)		;PUT EQUIVALENCE NAME MNEMONIC BACK IN DPB
	MOV	R0,2(R4)	;SAME FOR THE UNIT NUMBER
	MOV	$DEVHD,R2	;GET ADDRESS OF DEVICE TABLE
35$:	CMP	(R4),D.NAM(R2)	;IS THIS THE DEVICE ?
	BEQ	45$		;YES
40$:	MOV	D.LNK(R2),R2	;NO, POINT TO NEXT DCB
	BNE	35$		;GOT ONE
	BR	70$		;END OF DEVICES, ERROR
45$:	MOV	2(R4),R5	;GET UNIT NUMBER
	CMPB	R5,D.UNIT(R2)	;IS UNIT ON THIS DCB?
	BLO	40$		;NO
	CMPB	R5,D.UNIT+1(R2) ;MAYBE
	BHI	40$		;NO!
	CLR	R3		;GET FIRST UNIT NUMBER
	BISB	D.UNIT(R2),R3	;
	MOV	D.UCB(R2),R1	;GET FIRST UCB ADDRESS
	SUB	R3,R5		;COMPUTE RELATIVE UNIT NUMBER
	BEQ	55$		;FOUND IT
50$:	ADD	D.UCBL(R2),R1	;NO, POINT TO NEXT UCB
	DEC	R5		;FOUND IT YET?
	BNE	50$		;NO, LOOP
55$:	MOVB	7(R4),-(SP)	;SAVE THE LOGIN FLAG
	MOV	R1,R4		;GET A COPY OF THE UCB ADDRESS
	TSTB	(SP)+		;SEE IF THIS WAS A LOGIN ASSIGNMENT LOOKUP
	BPL	65$		;IF PL, NO, LEAVE UCB ADDRESS AS IS

	.ENDC	;DF L$$GCL

60$:	CMP	U.RED(R4),R4	;END OF REDIRECT CHAIN
	BEQ	65$		;IF EQ YES, FINISHED
	MOV	U.RED(R4),R4	;POINT TO NEXT UCB
	BR	60$		;AND GO AGAIN
65$:				;REFERENCE LABEL	
	MOV	(SP)+,R3	;RESTORE THE USER BUFFER ADDRESS
	CALLR	$GLINF		;CONTINUE THROUGH GET LUN INFORMATION
70$:	DRSTS	D.RS92		;INVALID DEVICE
80$:	DRSTS	D.RS5		;NO DEVICE IS ASSIGNED
 
;+
; **-$SFUIC-GET SYSUIC, LIBUIC, CURRENT UIC, PROTECTION UIC, AND LOGIN UIC
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO RETURN THE SYSTEM UIC,
; THE LIBRARY UIC, AND THE TASK'S CURRENT AND PROTECTION UICS,
; AND TI LOGIN UIC. IF SPACE IS AVAILABLE, TRANSFER OTHER UIC AND CLI
; INFORMATION.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(4.).
;	WD. 01 -- SUBFUNCTION CODE (1) (LOW BYTE).
;	WD. 02 -- BUFFER ADDRESS.
;	WD. 03 -- BUFFER SIZE (IN WORDS).
;
; BUFFER FORMAT:
;
;	WD. 00 -- SYSTEM UIC.
;	WD. 01 -- LIBRARY UIC.
;	WD. 02 -- H.DUIC FOR THE REQUESTING TASK.
;	WD. 03 -- H.CUIC FOR THE REQUESTING TASK.
;	WD. 04 -- LOGIN UIC.
;
; INPUTS:
;	
;	R2=NUMBER OF EXTRA WORDS IN USER BUFFER.
;	R3=ADDRESS OF WD. 00. OF THE BUFFER.
;	R5=TCB ADDRESS OF THE REQUESTING TASK.
;
; OUTPUTS:
;
;	THE USER'S BUFFER IS FILLED WITH THE REQUESTED INFORMATION.
;
;-
 
$SFUIC::MOV	$SYUIC,(R3)+	;MOVE SYSTEM UIC TO USER BUFFER
	MOV	$LBUIC,(R3)+	;MOVE LIBRARY UIC

	.IF DF	X$$HDR

	CLR	-(SP)		;RESERVE SPACE ON STACK
	CLR	-(SP)		; 
	MOV	KISAR6,-(SP)	;SAVE MAPPING TO USER BUFFER
	MOV	$SAHDB,KISAR6	;MAP NON RESIDENT TASK HEADER
	MOV	$SAHPT,R4	;GET HEADER ADDRESS OF CURRENT TASK
	MOV	H.DUIC(R4),2(SP) ;SAVE DEFAULT UIC 
	MOV	H.CUIC(R4),4(SP) ;SAVE CURRENT UIC
	MOV	(SP)+,KISAR6	;RESTORE MAPPING 
	MOV	(SP)+,(R3)+	;COPY CURRENT UIC
	MOV	(SP)+,(R3)+	;AND PROTECTION UIC TO USER BUFFER

	.IFF

	MOV	$HEADR,R4	;GET HEADER ADDRESS OF CURRENT TASK
	MOV	H.DUIC(R4),(R3)+  ;MOVE CURRENT UIC TO USER BUFFER
	MOV	H.CUIC(R4),(R3)+  ;MOVE PROTECTION UIC TO USER BUFFER

	.ENDC	;X$$HDR


	MOV	T.UCB(R5),R1	;GET TI UCB
	
	
	.IF DF	A$$CNT
	

	.IF DF	D$$PAR

	MOV	KISAR6,-(SP)	;SAVE USER BUFFER MAPPING
	MOV	T.ACN(R5),R0	;POINT TO ACCOUNTING BLOCK
	BEQ	5$		;IF EQ THERE ISN'T ONE
3$:	MOV	R0,KISAR6	;MAP IT
	MOV	@#B.PNT+140000,R0 ;POINT TO NEXT BLOCK
	CMPB	#BT.UAB,@#B.TYP+140000 ;IS THIS A UAB
	BNE	3$		;IF NE NO
	MOV	@#B.UUIC+140000,R0 ;GET LOGIN UIC FROM UAB
	BR	6$		;
5$:	MOV	U.LUIC(R1),R0	;GET LOGIN UIC
6$:	MOV	(SP)+,KISAR6	;RESTORE USER BUFFER MAPPING
	MOV	R0,(R3)+	;RETURN LOGIN UIC TO USER BUFFER

	.IFF	;D$$PAR

	MOV	T.ACN(R5),R0	;LOCATE FIRST ACCOUNTING BLOCK
	BEQ	10$		;IF EQ, THERE ISN'T ONE
7$:	MOV	R0,KISAR5	;MAP ACCOUNTING BLOCK
	MOV	@#B.PNT+120000,R0 ;POINT TO NEXT BLOCK
	CMPB	#BT.UAB,@#B.TYP+120000 ;IS THIS A UAB
	BNE	7$		;IF NE NO
	MOV	@#B.UUIC+120000,(R3)+  ;GET LOGIN UIC FROM THE UAB
	BR	20$		;GO MOVE MORE DATA
10$:	MOV	U.LUIC(R1),(R3)+ ;GET LOGIN UIC FROM UCB


	.ENDC	;D$$PAR

	

	.IFF	; DF A$$CNT

	MOV	U.LUIC(R1),(R3)+ ;GET LOGIN UIC FROM UCB

	.ENDC	; DF A$$CNT

	
	

;
; IN ORDER TO OBTAIN THE REMAINING DATA, THE USER MUST HAVE ALLOCATED
; AT LEAST A 32. WORD BUFFER.
;
20$:	SUB	#<32.-5.>,R2	;IS THERE ROOM FOR THE NEXT BLOCK OF DATA?
	BMI	110$		;IF MI NO
	MOV	U.UIC(R1),(R3)+ ;PUT CURRENT TERMINAL UIC
	MOV	U.MUP(R1),R1	;PICK UP INDEX TO COB POINTER
	BIC	#^C<UM.CLI>,R1	;AND ONLY THE INDEX
	MOV	$CPTBL(R1),R1	;GET POINTER TO CPB
	MOV	(R1),R2		;GET TCB ADDRESS OF CLI
	MOV	@#KISAR6,-(SP)	;SAVE CURRENT APR6 MAPPING
	BIT	#CP.POL,C.PSTS(R1) ;TCB IN SECONDARY POOL?
	BEQ	40$		;IF EQ NO
	MOV	R2,KISAR6	;MAP TCB
	MOV	#140000,R2	;AND POINT TO IT
40$:	MOV	T.NAM(R2),R1	;GET CLI TASKNAME
	MOV	T.NAM+2(R2),R2	;
	MOV	(SP)+,@#KISAR6	;RESTORE APR6 MAPPING
	MOV	R1,(R3)+	;AND COPY CLI TASKNAME INTO USER BUFFER
	MOV	R2,(R3)+	;
	MOV	#$SYSNM,R1	;POINT TO SYSTEM NAME
	MOV	(R1)+,(R3)+	;SHUFFLE THE 6-CHARACTER NAME TO USER
	MOV	(R1)+,(R3)+	;...
	MOV	(R1)+,(R3)+	;...
	MOV	$NTUIC,(R3)+	;SUPPLY THE NETWORK UIC
	MOV	$SYSIZ,(R3)+	;AND SYSTEM SIZE IN 32 WORD BLOCKS

	.IF DF	A$$CNT

	MOV	#9.,-(SP)	;MAX LENGTH OF DDS
	MOV	KISAR6,-(SP)	;SAVE USER BUFFER MAPPING
	MOV	T.ACN(R5),R1	;POINT TO ACCOUNTING BLOCK
	BEQ	70$		;IF EQ THERE ISN'T ONE
50$:	MOV	R1,KISAR6	;MAP IT
	MOV	@#B.PNT+140000,R1 ;POINT TO NEXT BLOCK
	CMPB	#BT.UAB,@#B.TYP+140000 ;IS THIS A UAB
	BNE	50$		;IF NE NO
	MOVB	@#B.LDS+140000,R0 ;GET LENGTH OF DDS FROM UAB
	BEQ	70$		;IF EQ, NO DDS
	SUB	R0,2(SP)	;SUBTRACT LENGTH OF DDS
	MOV	#B.LDS+120000,R2 ;ADDRESS OF DDS IN UAB
	MOV	R3,R4		;DISPLACEMENT INTO BUFFER
	MOV	(SP),R3		;USER BUFFER MAPPING BIAS
	INC	R0		;COPY SIZE BYTE ALSO
	MOV	KISAR6,R1	;RESTORE UAB BIAS
	CALL	$BLXIO		;COPY DDS FROM ACCOUNTING BLOCK TO BUFFER
	MOV	(SP)+,KISAR6	;RESTORE MAPPING
	BR	80$		;
70$:	MOV	(SP)+,KISAR6	;RESTORE MAPPING
	CLRB	(R3)+		;RETURN LENGTH TO USER BUFFER
	MOV	R3,R4		;MOVE BUFFER POINTER TO R4
80$:	TST	(SP)		;IS THERE NEED TO ZERO FILL
	BEQ	100$		;NO, DDS WAS MAX LENGTH
90$:	CLRB	(R4)+		;ZERO OUT REMAINING BUFFER SPACE
	DEC	(SP)		;LENGTH REMAINING ON STACK
	BNE	90$		;LOOP UNTIL DONE
100$:	TST	(SP)+		;CLEAN STACK

	.ENDC 	;A$$CNT

110$:	RETURN
 
;+
; **-$SFDEF-SET TASK DEFAULT UIC
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO SET THE DEFAULT UIC FOR THE
; REQUESTING TASK.  IF THE TASK IS NON-PRIVILEGED, ONLY THE DEFAULT UIC
; IS CHANGED.  IF THE TASK IS PRIVILEGED, BOTH THE DEAFULT AND PROTECTION
; UICS ARE MODIFIED.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(3.).
;	WD. 01 -- SUBFUNCTION CODE (2) (LOW BYTE).
;	WD. 02 -- DEFAULT UIC.
;
; INPUTS:
;
;	R3=ADDRESS OF DEFAULT UIC IN THE DPB.
;	R5=TCB ADDRESS OF THE CURRENT TASK.
;
; OUTPUTS:
;
;	THE DEAFULT UIC IS SET FOR THE REQUESTING TASK.
;
;-
 
$SFDEF::TSTB	T.GGF(R5)	;IS THER A GGF CONTEXT ACTIVE?
	BEQ	5$		;IF EQ, NO
	DRSTS	D.RS17		;RETURN IE.RSU ERROR
5$:	MOV	(R3),R1		;GET SPECIFIED UIC
	BEQ	100$		;IF EQ UIC IS INVALID

	.IF DF C$$RMT		;REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	;REMOTE TASK SUPPORT TURNED ON?
	BEQ	40$		;IF EQ, NO
;
; GET A REQUEST PACKET FROM CPRBUF
;
	MOV	R3,R5		;SAVE DPB POINTER
	
	MOV	#1,R1		;ALLOCATE ONE BLOCK
	MOV	#AL$BCK!AL$IMP,R0 ;BLOCK THE TASK, DO IMPLICIT START
	CALL	$CPALO		;ALLOCATE THE BUFFER
;
; FILL IN PACKET
;
	MOV	R0,KISAR6	;MAP PACKET
	MOV	#MAP6,R1	;GET ADDRESS OF PACKET	
	MOVB	#HT$DIR,H$TYPE(R1) ;DIRECTIVE REQUEST
	CLRB	H$ICNT(R1)	;NO ITEMS
	ADD	#P$DPB,R1	;POINT TO DPB AREA
	MOV	-4(R5),(R1)+	;COPY FIRST WORD OF DPB
	MOV	-2(R5),(R1)+	;COPY SECOND WORD
	MOV	(R5),(R1)+	;AND THIRD
;
; SEND PACKET	
;
	SUB	#MAP6,R1	;GET SIZE OF PACKET
	CPSEN$	#SN$DIR,KISAR6,R1	
;
; GET RESULTS 
; 
	MOV	R0,KISAR6	;MAP PACKET
	MOV	#MAP6,R3	;POINT TO BEGINNING OF PACKET
	CMP	#IS.SUC,H$STAT(R3) ;DID IT SUCCEED?
	BEQ	20$		   ;IF EQ YES
	CMP	#IE.PRI,H$STAT(R3) ;FAIL BECAUSE NO PRIVILEGE?
	BEQ	20$		   ;YES
	CALLR	$CPDEA		;DEALLOCATE PACKET AND RETURN
20$:
;
; DEALLOCATE PACKET AND SET UP FOR COMMON CODE
;
	MOV	H$STAT(R3),-(SP) ;SAVE RETURNED STATUS
	ADD	#P$DPB,R3	;POINT TO DPB
	MOV	4(R3),-(SP)	;SAVE UIC
	CALL	$CPDEA		;DEALLOCATE PACKET
	MOV	(SP)+,R1	;GET UIC
	MOV	$TKTCB,R5	;GET TCB ADDRESS
40$:
	.ENDC	; C$$RMT

	.IF DF	X$$HDR

	MOV	$SAHDB,KISAR6	;MAP TASK HEADER
	MOV	$SAHPT,R2	;GET TASK HEADER ADDRESS

	.IFF	; DF X$$HDR

	MOV	$HEADR,R2	;GET TASK HEADER ADDRESS
	
	.ENDC	; DF X$$HDR


	MOV	R1,H.DUIC(R2)	;SET DEFAULT UIC

	.IF DF	C$$RMT		;REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	;REMOTE TASK SUPPORT TURNED ON?
	BEQ	45$		;IF EQ, NO
	CMP	#IE.PRI,(SP)+	;REMOTE HAVE INSUFFICIENT PRIVILEGE?
	BNE	45$		;NO, CONTINUE TO SET H.CUIC
	MOV	#IS.SUC,-(SP)	;PUT SUCCESS STATUS ON STACK
	BIC	#1,$UMPS	;CLEAR USER'S CARRY
	MTPD$	@#H.DSW		;PUT SUCCESS IN DIRECTIVE STATUS WORD
	BR	50$		;AND EXIT	
45$:
	.ENDC	; DF C$$RMT

	BIT	#T3.PRV,T.ST3(R5) ;TASK PRIVILEGED?
	BEQ	50$		;IF EQ NO
	MOV	R1,H.CUIC(R2)   ;SET PROTECTION UIC
50$:	RETURN
100$:	DRSTS	D.RS91		;INVALID UIC
;+
; **-$SFSPR-SET TASK PRIVILEGE
;
; THIS DIRECTIVE REQUEST THE SET/CLEAR OF THE TASK PRIVILEGE BIT IN
; THE TCB. THE PRIVILEGE BIT MAY BE CLEARED IN ANY STATE BUT MAY BE
; SET ONLY IF IT WAS PREVIOUSLY CLEARED.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(3.)
;	WD. 01 -- SUBFUNCTION CODE (7)
;	WD. 02 -- NEW PRIVILEGE FLAG (BIT 0)
;
; INPUT:
;
;	R3=ADDRESS OF PRIVILGE FLAG IN DPB
;	R5=TCB ADDRESS OF CURRENT TASK
;
; OUTPUT:
;
;	THE T3.PRV BIT IS SET OR CLEARED. THE PREVIOUS STATE OF T3.PRV IS
; 	SAVED IN T4.PRV.
;-

$SFSPR::MOV	T.ST3(R5),R2	;GET CURRENT PRIVILEGE
	BIC	#^C<T3.PRV>,R2	;AND ISOLATE PRIVILEGE BIT
	BEQ	30$		;IF EQ NOT CURRENTLY PRIVILEGED
	BIS	#T4.PRV,T.ST4(R5)  ;COPY PRIVILEGED STATE
	BEQ	30$		;IF EQ NOT CURRENTLY PRIVILEGED
	TST	(R3)		;SET OR CLEAR PRIVILEGE?
	BNE	40$		;IF NE SETTING PRIVILEGED BIT
	BIC	R2,T.ST3(R5)	;CLEAR PRIVILEGE
	RETURN			;

30$:	TST	(R3)		;SET OR CLEAR PRIVILEGE?
	BEQ	50$		;IF EQ CLEARING.  THIS IS A NOP
40$:	BIT	#T4.PRV,T.ST4(R5)  ;WAS IT PRIVILEGED?
	BEQ	60$		;IF EQ NO, CAN'T MAKE SELF PRIVILEGED
	BIS	#T3.PRV,T.ST3(R5)  ;MAKE IT PRIVILEGED
50$:	RETURN			;
60$:	DRSTS	D.RS16		; PRIVILEGE ERROR

;+
; **-$SFREN-RENAME TASK
;
; THIS DIRECTIVE RENAMES THE ISSUING TASK TO THE SUPPLIED TASK NAME.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(3.)
;	WD. 01 -- SUBFUNCTION CODE (7)
;	WD. 02-03 -- NEW TASK NAME
;
; INPUT:
;
;	R3=ADDRESS OF NEW TASK NAME IN DPB
;	R5=TCB ADDRESS OF CURRENT TASK
;
; OUTPUT:
;
;	THE NEW NAME IS CHECKED FOR UNIQUENESS AND IF NOT FOUND, THE
;	ISSUING TASK IS RENAMED TO THE NEW NAME.
;-

$SFREN::CMP	#^R...,(R3)	;DON'T ALLOW RENAME TO A DOT-DOT-DOT FORM
	BEQ	10$		;IF EQ ILLEGAL NAME
	CALL	$SRPRO		;SEARCH PROTOTYPE TCB AND TCB LISTS FOR NAME
	BCC	10$		;IF CC NAME FOUND, ERROR
	MOV	(R3),T.NAM+0(R5);ESTABLISH NEW NAME FOR THIS TASK
	MOV	2(R3),T.NAM+2(R5)  ;...
	RETURN
10$:	DRSTS	D.RS17		;NAME ALREADY IN USE(IE.RSU ERROR)

 
;+
; **-$SFFMK-GET FEATURE MASK WORDS, BASE LEVEL, VERSION, AND SYSTEM TYPE
;
; THIS DIRECTIVE RETURNS THE FEATURE MASK WORDS TO THE REUESTING TASK.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(4.).
;	WD. 01 -- SUBFUNCTION CODE (3) (LOW BYTE).
;	WD. 02 -- BUFFER ADDRESS.
;	WD. 03 -- BUFFER SIZE IN WORDS.
;
; BUFFER FORMAT:
;
;	WD. 00 -- FIRST FEATURE MASK WORD.
;	WD. 01 -- SECOND FEATURE MASK WORD.
;	WD. 02 -- THIRD FEATURE MASK WORD.
;	WD. 03 -- FOURTH FEATURE MASK WORD.
;	WD. 04 -- HARDWARE FEATURE MASK WORD.
;	WD. 05 - 06 -- SYSTEM BASE LEVEL.
;	WD. 07 - 10 -- SYSTEM VERSION.
;	WD. 11 - 16 -- SYSTEM TYPE (RETURNED ONLY IF BUFFER IS 
;				    AT LEAST 15. WORDS LONG)
;	WD. 11 - 17 -- FIFTH FEATURE MASK WORD (RETURNED ONLY IF 
;		       BUFFER IS AT LEAST 16. WORDS LONG)
;	WD. 11 - 20 -- SIXTH FEATURE MASK WORD (RETURNED ONLY IF
;		       BUFFER IS AT LEAST 17. WORDS LONG)
;
; INPUTS:
;
;	R2=NUMBER OF EXTRA WORDS IN USER BUFFER.
;	R3=ADDRESS OF WD. 00. OF THE BUFFER.
;	R5=TCB ADDRESS OF THE CURRENT TASK.
;
; OUTPUTS:
;
;	THE INFORMATION IS RETURNED TO THE CALLER.
;
;-
 
$SFFMK::MOV	#$FMASK,R0	;GET ADDRESS OF FEATURE MASK
	MOV	(R0)+,(R3)+	;MOVE FIRST FEATURE MASK WORD
	MOV	(R0)+,(R3)+	;MOVE SECOND FEATURE MASK WORD
	MOV	(R0)+,(R3)+	;MOVE THIRD FEATURE MASK WORD
	MOV	(R0)+,(R3)+	;MOVE FOURTH FEATURE MASK WORD
	MOV	$HFMSK,(R3)+	;MOVE HARDWARE FEATURE MASK WORD
	MOV	$SYSID,(R3)+	;MOVE BASE LEVEL TO USER BUFFER
	MOV	$SYSID+2,(R3)+	;
	MOV	$VERSN,(R3)+	;MOVE SYSTEM VERSION TO USER BUFFER
	MOV	$VERSN+2,(R3)+	;
;
; SYSTEM TYPE IS RETURNED ONLY IF THERE ARE AT LEAST 6 EXTRA WORDS IN THE BUFFER
;
	SUB	#6,R2		;AT LEAST 6 EXTRA WORDS?
	BMI	10$		;NO, RETURN NOW
	MOV	#$SYTYP,R0	;ADDRESS OF SYSTEM TYPE
	MOV	#6,R1		;WORD COUNT
5$:	MOV	(R0)+,(R3)+	;MOVE SYSTEM TYPE TO USER BUFFER
	SOB	R1,5$		;ALL SIX BYTES
	DEC	R2		;AT LEAST 1 EXTRA WORD?
	BMI	10$		;NO, RETURN NOW
	MOV	$FMSK5,(R3)+	;MOVE FIFTH FEATURE MASK TO USER BUFFER
	DEC	R2		; ONE MORE WORD?
	BMI	10$		; NOPE, QUIT NOW ...
	MOV	$FMSK6,(R3)+	; MOVE SIXTH FEATURE MASK WORD INTO BUFFER
10$:	RETURN			;

 
;+
; **-$SFQMC-QUEUE MCR COMMAND LINE
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO QUEUE A COMMAND LINE TO THE
; TASK'S COMMAND LINE INTERPRETER.
;
;  DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(4.).
;	WD. 01 -- CODE FOR SFQMC (LOW BYTE).
;	WD. 02 -- BUFFER ADDRESS.
;	WD. 03 -- BUFFER SIZE (IN WORDS).
;
; BUFFER FORMAT:
;
;	WD. 00 THRU N -- COMMAND LINE CHARACTERS.
;
; INPUTS:
;
;	R2=NUMBER OF EXTRA WORDS IN USER BUFFER.
;	R3=ADDRESS OF USER BUFFER WD. 00.
;	R5=TCB ADDRESS OF CURRENT TASK.
;
; OUTPUTS:
;
;	C=0 IF THE DIRECTIVE SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS1' IS RETURNED IF THERE
;		IS INSUFFICIENT DYNAMIC MEMORY AVAILABLE.
;
;-
 
$SFQMC::
	
	
	.IF DF	V$$TRM
	
	MOV	T.UCB(R5),R1	;GET TI: UCB
	MOV	U.DCB(R1),R0	;GET DCB
	CMP	D.NAM(R0),#"VT	;IS TI A VIRTUAL TERMINAL?
	BNE	5$		;IF NE NO
	TST	U.PTCB(R1)	;IS VT MARKED FOR ELIMINATION?
	BEQ	90$		;IF EQ YES
	
	.ENDC
	
	
5$:	MOV	#M$$CRB,R1	;GET SIZE OF MCR COMMAND LINE BUFFER
	CALL	$ALOCB		;ALLOCATE A BUFFER
	BCS	100$		;IF CS ALLOCATION FAILURE
	MOV	R0,R1		;COPY BUFFER ADDRESS
	TST	(R0)+		;POINT TO UCB ADDRESS IN BUFFER
	MOV	T.UCB(R5),(R0)+	;SET TI UCB ADDRESS
	MOV	#M$$CRB-4,R2	;SET LOOP COUNT
10$:	MOVB	(R3)+,(R0)	;MOVE COMMAND TO POOL BUFFER
	CMPB	(R0),#15	;CARRIAGE RETURN?
	BEQ	50$		;IF EQ YES
	CMPB	(R0)+,#33	;ESCAPE?
	BEQ	50$		;IF EQ YES
	SOB	R2,10$		;CONTINUE MOVING COMMAND TO THE POOL
	MOVB	#33,-(R0)	;TERMINATE BUFFER WITH AN ESCAPE
50$:	CALLR	$QMCRL		;QUEUE THE COMMAND LINE TO THE CLI
90$:	DRSTS	D.RS92		;VIRTUAL TERMINAL MARKED FOR ELIMINATION
100$:	DRSTS	D.RS1		;ALLOCATION FAILURE
 
;+
; **-$SFUAB-GET USER ACCOUNT BLOCK
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO MOVE THE CONTENTS OF A
; USER ACCOUNT BLOCK TO A USER BUFFER.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(6.)
;	WD. 01 -- SUBFUNCTION CODE (5) (LOW BYTE).
;	WD. 02 -- BUFFER ADDRESS.
;	WD. 03 -- BUFFER SIZE (IN WORDS).
;	WD. 04 -- TERMINAL NAME (0 FOR CALLER'S TI).
;	WD. 05 -- TERMINAL NUMBER.
;	
; INPUTS:
;
;	R2=NUMBER OF EXTRA WORDS IN USER BUFFER.
;	R3=ADDRESS OF USER BUFFER WD. 00.
;	R4=POINTER TO WORD 04 OF THE DPB.
;	R5=TCB ADDRESS OF THE CURRENT TASK.
;
; OUTPUTS:
;
;	C=0 IF THE DIRECTIVE SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF THE DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS16' IS RETURNED IF 
;		A NON-PRIVILEGED USER SPECIFIES A TERMINAL.
;		DIRECTIVE STATUS OF 'D.RS92' IS RETURNED IF
;		THE SPECIFIED DEVICE IS NOT A TERMINAL OR
;		IF THERE IS NO UAB FOR THE DEVICE.
;
;-
 
	
	
	.IF DF	A$$CNT
	
$SFUAB::MOV	T.UCB(R5),R2	;ASSUME TERMINAL NOT SPECIFIED
	MOV	T.ST3(R5),R1	;GET THIRD STATUS WORD
	MOV	R3,R5		;COPY USER BUFFER ADDRESS
	MOV	(R4)+,R0	;GET TERMINAL NAME FROM THE DPB
	BEQ	10$		;IF EQ NOT SPECIFIED
	BIT	#T3.PRV,R1 	;TASK PRIVILEGED?
	BEQ	80$		;IF EQ NO
	MOV	(R4),R1		;GET TERMINAL NUMBER
	CALL	$CVDVN		;GET UCB ADDRESS
	BCS	90$		;IF CS DEVICE NOT FOUND
	BIT	#DV.TTY,U.CW1(R2) ;IS DEVICE A TERMINAL?
	BEQ	90$		;IF EQ NO
	CMP	$COPT,R2	;IS UCB EQUAL TO CO?
	BNE	10$		;IF NE NO

	.IF DF	D$$PAR

	MOV	$SYUAB,R1	;PICK UP BIAS TO SYSTEM UAB
	BR	15$		;
10$:	MOV	U.UAB(R2),R1	;PICK UP BIAS TO UAB
15$:	BEQ	90$		;IF EQ THERE IS NO UAB
	MOV	#B.ULEN,R0	;SET COUNT OF WORDS TO MOVE
	MOV	#120000,R2	;DISPLACEMENT (APR5) TO UAB
	MOV	KISAR6,R3	;GET USER BUFFER MAPPING
	MOV	R5,R4		;GET DISPLACEMENT TO USER BUFFER (APR6)
	CALL	$BLXIO		;MOVE UAB TO USER BUFFER

	.IFF	;D$$PAR

	MOV	$SYUAB,KISAR5	;MAP TO THE SYSTEM UAB
	BR	15$		;
10$:	MOV	U.UAB(R2),KISAR5 ;MAP THE UAB THROUGH APR 6
15$:	BEQ	90$		;IF EQ THERE IS NO UAB
	MOV	#B.ULEN/2,R0	;SET COUNT OF WORDS TO MOVE
	MOV	#120000,R1	;SET SOURCE ADDRESS
20$:	MOV	(R1)+,(R5)+	;COPY UAB TO USER BUFFER
	SOB	R0,20$		;LOOP UNTIL DONE

	.ENDC	;D$$PAR

	RETURN			;
80$:	DRSTS	D.RS16		;PRIVILEGE VIOLATION
90$:	DRSTS	D.RS92		;INVALID DEVICE SPECIFIED

	.ENDC	;A$$CNT

 
;+
; **-$SFDEV-GET DEVICE INFORMATION
;
;
; THE GET DEVICE INFORMATION GIN DIRECTIVE:
;
;	THIS GIN SUBFUNCTION RETURNS INFORMATION ABOUT A PARTICULAR     
;	DEVICE. THE DEVICE ON WHICH INFORMATION IS RETURNED, IS
;	DETERMINED BY FIRST PERFORMING A LOGICAL ASSIGNMENT IF REQUIRED
;	AND THE FOLLOWING ANY REDIRECTS. DEVICE ASSIGNMENTS WILL BE
;	CHECKED IF THE HIGH BIT IN THE FLAGS BYTE IS CLEAR, ELSE NO
;	CHECK IS MADE.
;
;	ONLY THE FIRST WORD OF THE BUFFER IS REQUIRED TO BE PRESENT
;	(IE: A BUFFER SIZE OF 1 WORD). ADDITIONAL INFORMATION IS
;	RETURNED ONLY IF THERE IS ROOM IN THE BUFFER AND THAT
;	INFORMATION IS AVAILABLE. 
;
; INPUTS:
;
;	R2 =  EXTRA WDS. AVAILABLE IN USER BUFFER
;	R3 =  POINTER TO USER BUFFER (MAPPED THROUGH APR 6)
;	R4 =  POINTER TO "G.IDNM" IN DPB
;	R5 =  CURRENT TASK'S TCB ADDRESS
;
;
;
; DPB FORMAT:
;
; +-----------------------------+-------------------------------+
; |	DPBLEN=6.		|	DIC=169.		|
; +-----------------------------+-------------------------------+
; |			GIN SUBFUNCTION CODE	(6)		|
; +-------------------------------------------------------------+
; |			BUFFER ADDRESS				|
; +-----------------------------+-------------------------------+
; |			BUFFER SIZE	(WORDS!!)		|
; +-----------------------------+-------------------------------+
; |			ASCII DEVICE NAME			|
; +-----------------------------+-------------------------------+
; |	FLAGS			|	DEVICE UNIT NUMBER	|
; +-----------------------------+-------------------------------+
;
;-

;
; DPB OFFSETS AND FLAG DEFINITIONS:
;

G.INSF=2	; LOCATION OF SUBFUNCTION CODE
G.IDNM=10	;TWO BYTE ASCII DEVICE NAME
G.IDUN=12	;LOGICAL UNIT NUMBER BYTE
G.IDFG=13	;FLAGS BYTES


GI.NAS=200	;FLAG INDICATING NOT TO FOLLOW ANY ASSIGNMENTS

;
;
; USER BUFFER FORMAT:
;
;
; +-------------------------------+-------------------------------+
; | U | A | A | C | U | U | W | U | O | U | U | U | U | A | A | W |
; | N | T | L | O | S | S | A | N | F | S | S | S | S | T | L | A |
; | L | T | L | N | . | . | S | I | F | . | . | . | . | T | L | S |
; | O | C | O | T | U | P |   | T | L | M | F | M | L | A | O |   |
; | A | H | C | R | M | U | R |   | I | N | O | D | A | C | C | A |
; | D | 2 | 2 |   | D | B | E | O | N | T | R | M | B | H | A | S |
; | E | U | U | O |   |   | D | F | E |   |   |   |   | E | T | N |
; | D | S | S | F |   |   | C | L |   |   |   |   |   | D | E | D |
; |   |   |   | L |   |   | T |   |   |   |   |   |   |   | D |   |
; +-------------------------------+-------------------------------+
; |								  |
; |			      U.CW1				  |
; |								  |
; +-------------------------------+-------------------------------+
; |								  |
; |			      U.PRM				  |
; |								  |
; +---------------------------------------------------------------+
; |								  |
; |			      U.PRM+2				  |
; |								  |
; +---------------------------------------------------------------+
; |								  |
; |			ASCII DEVICE NAME			  |
; |								  |
; +-------------------------------+-------------------------------+
; |				|				  |
; |	L.TYPE if "WAS ASND"	|	DEVICE LOGICAL UNIT	  |
; |	L.NTBL - EXTENDED LOG	|	       NUMBER		  |
; +---------------------------------------------------------------+
; |								  |
; |---		     ATTACHEE'S RAD50 TASKNAME		       ---|
; |			( IF ATTACHED )				  |
; +---------------------------------------------------------------+
; |		ASCII TERMINAL DEVICE NAME OF ALLOCATOR		  |
; |---			( IF ALLOCATED )		       ---|
; |		  LOGICAL UNIT NUMBER OF ALLOCATOR		  |
; +---------------------------------------------------------------+
; |								  |
; |---			RAD50 ACP NAME			       ---|
; |			( IF MOUNTED )				  |
; +---------------------------------------------------------------+
; |				|				  |
; |---			       -+-			       ---|
; |				|				  |
; |---			       -+-			       ---|
; |				|				  |
; |---			       -+-			       ---|
; |			  VOLUME LABEL				  |
; |---			       -+-			       ---|
; |				|				  |
; |---			       -+-			       ---|
; |				|				  |
; +---------------------------------------------------------------+
;
;

;
; OFFSET AND STATUS WORD DEFINITIONS:
;

G.IDEV=0	;GENERAL DEVICE STATUS WORD (REQUIRED)
		;NOTE THAT REQUIRED WORDS ARE NOT REFLECTED IN
		;THE "EXTRA WORD COUNT" PASSED TO THIS SUBFUNCTION
		;BY DRGIN.
G.ICW1=2	;U.CW1   FROM DEVICE'S UCB
G.IPR1=4	;U.PRM   FROM DEVICE'S UCB
G.IPR2=6	;U.PRM+2 FROM DEVICE'S UCB
G.IDNM=10	;RESOLVED ASCII DEVICE NAME
G.IUNM=12	;RESOLVED DEVICE UNIT NUMBER
G.ILTP=13	;TYPE OF LOGICAL ASSIGNMENT FOLLOWED
G.IATT=14	;RAD50 TASK NAME OF ATTACHER IF DEVICE ATTACHED
G.IALL=20	;ASCII TERMINAL NAME OF ALLOCATOR IF DEVICE ALLOCATED
G.IACP=24	;NAME OF ACP IF DEVICE MOUNTED
G.IVOL=30	;VOLUME NAME IF NOT MOUNTED AS ANSI TAPE
G.IVID=G.IVOL	;VOLUME SET ID IF ANSI TAPE
G.ITLB=G.IVID+6	;VOLUME ID IF ANSI TAPE
G.IEND=G.IVOL+14;END OF USER BUFFER

;
; 'G.IDEV' STATUS WORD DEFINITION:
;

GI.ASN=000001			;A LOGICAL ASSIGNMENT WAS FOLLOWED (1=YES)
GI.ALL=000002			;DEVICE ALLOCATED (1=YES)
GI.ATT=000004			;DEVICE ATTACHED (1=YES)
GI.LAB=000010			;UNIT HAS LABELED TAPE (1=YES)
GI.MDM=000020			;(US.MDM) UNIT IS MARKED
				;         FOR DISMOUNT (1=YES)
GI.FOR=000040			;(US.FOR) UNIT IS MOUNTED AS FOREIGN
				;         VOLUME (1=YES)
GI.MNT=000100			;(US.MNT) UNIT IS MOUNTED (0=YES)
GI.OFL=000200			;UNIT OR CONTROLLER OFFLINE
GI.UOF=000400			;(US.OFL) UNIT OFFLINE (1=YES)
GI.RED=001000
GI.PUB=002000			;(US.PUB) UNIT IS PUBLIC DEVICE (1=YES)
GI.UMD=004000			;(US.UMD) UNIT ATTACHED FOR
				;         DIAGNOSTICS (1=YES)
GI.COF=010000			;DEVICE'S CONTROLLER
				;	  WAS OFFLINE (1=YES)
GI.ALU=020000			;DEVICE WAS ALLOCATED BY THE
				;	  ISSUER'S TI: (1=YES)
GI.ATU=040000			;DEVICE WAS ATTACHED BY ISSUER (1=YES)
GI.UNL=100000			;DEVICE'S DRIVER NOT LOADED (1=YES)

;
; DEFINE UCB AND MAGTAPE DEFINITIONS LOCALLY
;
	.MCALL	MTADF$,UCBDF$
	MTADF$			;DEFINE MAGTAPE DATA STRUCTURES
	UCBDF$			;DEFINE UCB DATA STRUCTURE
;
; SINCE MANY OF THE STATUS BITS ARE DIRECTLY COPIED FROM
; U.STS AND U.ST2 OF THE UCB, WE MUST ASSUME THE FOLLOWING:
; 
	ASSUME GI.MDM,US.MDM
	ASSUME GI.FOR,US.FOR
	ASSUME GI.MNT,US.MNT
	ASSUME GI.UOF,<US.OFL*256.>
	ASSUME GI.PUB,<US.PUB*256.>
	ASSUME GI.UMD,<US.UMD*256.>
;
; THE FOLLOWING BITS IN THE STATUS WORD ARE NOT COPIED FROM
; U.STS AND U.ST2 OF THE DEVICE'S UCB. THEREFORE THE FOLLOWING
; BIT MASK IS USED TO CLEAR OUT THE UNUSED BITS.
;

CLRMSK=GI.UNL!GI.ATU!GI.ALU!GI.RED!GI.OFL!GI.ATT!GI.ALL!GI.ASN!GI.LAB


;
;    THE FOLLOWING SECTION OF THIS GIN FUNCTION ATTEMPTS
; TO LOCATE THE CORRECT UCB ADDRESS OF THE DEVICE SPECIFIED
; IN THE DPB. INITIALLY, A SEARCH IS MADE TO DETERMINE IF
; A LOGICAL ASSIGNMENT IS IN EFFECT FOR THE ISSUING TASK.
; THE LOGICAL ASSIGNMENT MAY BE SYSTEM WIDE (GLOBAL), LOGIN, OR
; LOCAL TO THE TI: OF THE TASK AS SPECIFIED BY THE "L.TYPE" FIELD
; IN THE LOGICAL ASSIGNMENT BLOCK. IF THE TASK HAS THE "SLAVE"
; ATTRIBUTE OR IF THE "GI.NAS" FLAG HAS BEEN SET, THEN LOGICAL
; ASSIGNMENTS WILL NOT BE CHECKED.
;
; THIS CODE TO FIND THE UCB OF THE SPECIFIED DEVICE IS SHARED BY
; THE SON OF GET DEVICE INFORMATION SUBFUNCTION.
;
$SFDEV::

	MOV	R2,-(SP)	;SAVE EXTRA WORD COUNT
	CLR	-(SP)		;INITIALIZE SCRATCH WORD IN WHICH
				;THE 'GI.RED' AND 'GI.ASN' IS SAVED
	CLR	$TEMP0		;INITIALIZE SCRATCH WORD IN WHICH
				;WE WILL SAVE L.TYPE
	MOV	R3,R1		;COPY POINTER TO USER BUFFER
10$:	CLR	(R1)+		;CLEAR OUT USER BUFFER
	DEC	R2		; NOTE THAT USER BUFFER SIZE
	BPL	10$		; IS EXTRA WD. COUNT + 1
	MOV	(R4)+,R1	;GET DEVICE NAME (TWO ASCII CHARS.)
	MOV	(R4),R0		;GET UNIT NUMBER (LOW ORDER BYTE)
				;AND FLAGS BYTE (HIGH ORDER BYTE)
	
	.IF NDF C$$RMT		;IF NO REMOTE TASK SUPPORT

	MOV	G.INSF-G.IUNM(R4),R4 ; GET SUBFUNCTION WORD
	TST	R0		; RESET CONDITION CODES FOR LATER

	.IFF

	BIT	#F5.RTK,$FMSK5	; REMOTE TASK SUPPORT TURNED ON?
	BNE	11$		; IF NE, YES
	MOV	G.INSF-G.IUNM(R4),R4 ; GET SUBFUNCTION WORD
	TST	R0		;
	JMP	44$		; JOIN NON REMOTE CODE
11$:	ADD	#4,SP		; CLEAN STACK, WILL BE RETURNED LATER
;
; GET A REQUEST PACKET FROM CPRBUF
;
	SUB	#12,R4		; POINT BACK TO BEGINNING OF DPB
	MOV	6(R4),R1	; GET SIZE OF BUFFER
	CMP	R1,#44		; IS IT LARGER THAN MAXIMUM?
	BLE	12$		; IF LE, OKAY
	MOV	#22,R1		; SET LENGTH TO 22
	MOV	#22,6(R4)	; SET LENGTH IN DPB ALSO (?)
12$:
	ASL	R1		;  * 2
	ADD	#H$SIZE+14+4,R1 ; ADD SIZE OF HEADER, DPB AND STORAGE AREA	
	ADD	#77,R1		; ROUND TO NEAREST 32 WD BLOCK
	ASH	#-6,R1		;
	MOV	R2,R5		; SAVE EXTA WORD COUNT
	MOV	#AL$BCK!AL$IMP,R0 ; BLOCK THE TASK, DO IMPLICIT START
	CALL	$CPALO		; ALLOCATE THE BUFFER
;
; FILL IN PACKET
;
	MOV	R0,KISAR6	; MAP PACKET
	MOV	#MAP6,R1	; GET ADDRESS OF PACKET	
	MOVB	#HT$DIR,H$TYPE(R1) ; DIRECTIVE REQUEST
	CLRB	H$ICNT(R1)	; NO ITEMS
	ADD	#P$DPB,R1	; POINT TO DPB AREA
	MOV	R1,R3		; SAVE ADDRESS OF DPB IN PACKET

	CLR	R0		; MAKE SURE HIGH BYTE IS ZERO
	MOVB	1(R4),R0	; GET SIZE OF DPB IN WORDS
20$:	MOV	(R4)+,(R1)+	; COPY A WORD
	SOB	R0,20$		; LOOP UNTIL DONE

	MOV	4(R3),(R1)+	; SAVE ADDRESS OF USER BUFFER
	MOV	R5,(R1)+	; SAVE EXTRA WORD COUNT 
	MOV	R1,4(R3)	; PUT OFFSET TO BUFFER IN DPB
	SUB	#MAP6,4(R3)	; MAKE IT AN OFFSET
	MOV	6(R3),R0	; GET SIZE OF BUFFER
	ASL	R0		;  IN BYTES
	ADD	R0,R1		; GET SIZE OF PACKET
	SUB	#MAP6,R1	;  IN BYTES
;
; SEND PACKET TO AME
;
	CPSEN$	#SN$DIR,KISAR6,R1	
;
; GET ADDRESS OF USER BUFFER
;
	MOV	R0,KISAR6	; MAP PACKET
	MOV	#MAP6+P$DPB,R3	; POINT TO DPB
	MOV	14(R3),R0	; GET ADDRESS OF USER BUFFER
	CALL	$RELOC		; GET BIAS AND OFFSET IN R1,R2
;
; GET RESULTS 
; 
	MOV	#MAP6,R4	; POINT TO BEGINNING OF PACKET
	CMP	#IS.SUC,H$STAT(R4) ; DID IT SUCCEED?
	BEQ	30$		; IF EQ YES
	CMP	#IE.IDU,H$STAT(R4) ; INVALID DEVICE?
	BEQ	25$		; IF EQ, SETUP TO CHECK LOCAL DEVICES
	MOV	KISAR6,R0	; GET PACKET BIAS
	CALLR	$CPDEA		; DEALLOCATE PACKET AND RETURN
;
; ILLEGAL DEVICE RETURNED, CHECK LOCAL DEVICES
;	R1,R2 - BIAS OFFSET OF USER BUFFER
; 	R3 - POINTER TO DPB IN PACKET
;
25$:
	MOV	2(R3),R4	; GET SUBFUNCTION WORD
	CLR	$TEMP0		; MAKE SURE $TEMP0 HASN'T BEEN MUCKED WITH
	MOV	16(R3),-(SP)	; GET EXTRA WORD COUNT
	CLR	-(SP)		; GET BACK SCRATCH WORD
	MOV	R1,-(SP)	; SAVE BIAS OF USER BUFFER
	MOV	R2,-(SP)	; SAVE BUFFER ADDRESS
	MOV	10(R3),-(SP)	; SAVE DEVICE NAME
	MOV	12(R3),-(SP)	;  AND UNIT NUMBER
	MOV	KISAR6,R0	; GET PACKET BIAS
	CALL	$CPDEA		; DEALLOCATE PACKET
	MOV	(SP)+,R0	; GET UNIT NUMBER
	MOV	(SP)+,R1	;  AND DEVICE NAME
	MOV	(SP)+,R3	; GET BUFFER ADDRESS
	MOV	(SP)+,KISAR6	; MAP USER BUFFER
	TST	R0		;
	JMP	44$		; JOIN COMMON CODE
; 
; SUCCESS RETURNED, COPY INFORMATION INTO USER BUFFER
;	R1,R2 - BIAS OFFSET OF USER BUFFER
; 	R3 - POINTER TO DPB IN PACKET
;
30$:	
	MOV	6(R3),R0	; GET SIZE OF BUFFER
	ASL	R0		; IN BYTES
;WE COULD CHECK THAT THE BUFFER IS AT LEAST 12 BYTES, BUT WHY BOTHER
;  IF THE WORD HAPPENS TO BE $I OR $O WE'RE JUST MUCKING OUR OWN BUFFER
	CMP	#"$I,30(R3)	; IS DEVICE $I?
	BEQ	31$		; IF EQ YES
	CMP	#"$O,30(R3)	; IS DEVICE $O?
	BNE	33$		; IF NE NO
31$:	MOV	$TKTCB,R5	; GET TCB ADDRESS OF TASK
	MOV	T.UCB(R5),R5	; GET TI: UCB
	MOV	U.DCB(R5),R4	; GET TI: DCB
	MOV	D.NAM(R4),30(R3) ; CHANGE NAME
	MOVB	U.UNIT(R5),32(R3) ; GET UNIT NUMBER FROM UCB (ASSUME HT)
	CMP	#"VT,D.NAM(R4)	; IS THIS A VT?
	BNE	33$		; IF NE, U.UNIT IS CORRECT
	MOVB	D.UNIT(R4),32(R3) ; IF VT, D.UNIT IS CORRECT
33$:
	MOV	4(R3),-(SP)	; BIAS OF BUFFER IN PACKET
	MOV	R1,R3		; GET BIAS OF DESTINATION
	MOV	R2,R4		;  AND OFFSET
	MOV	KISAR6,R1	; GET SOURCE BIAS
	MOV	(SP)+,R2	;  AND OFFSET
	ADD	#120000,R2	; MAKE IT AN APR5 BIAS
	CALL 	$BLXIO		; COPY INFO INTO USER BUFFER

	MOV	KISAR6,R0	; GET PACKET BIAS
	CALLR	$CPDEA		; DEALLOCATE PACKET AND RETURN
;
; COMMON CODE WITH LOCAL GI.DEV
; 
; AT THIS POINT:
;	R1 	- DEVICE NAME
; 	R0 	- UNIT NUMBER
;	R3 	- ADDRESS OF USER BUFFER (MAPPED IN APR6)
;	R4	- WORD CONTAINING SUBFUNTION CODE
;	2(SP) 	- EXTRA WORD COUNT
;	(SP) 	- SCRATCH WORD
44$:
	.ENDC	; C$$RMT
	ASSUME GI.NAS, 200	;ASSUME THAT THE "INHIBIT ASSIGNMENTS"
				;FLAG IS THE SIGN BIT
	ASSUME G.IDFG, G.IDUN+1	;IN THE HIGH BYTE

	BMI	57$		;IF MI, INHIBIT ASSIGNMENTS
	BIT	#T3.SLV,T.ST3(R5) ;IS THE ISSUING TASK A SLAVE TASK?
	BNE	57$		;IF NE, YES..AVOID ASSIGNMENTS

	.IF DF	L$$GCL

	MOV	R3,-(SP)	;SAVE THE BUFFER ADDRESS ACROSS PROCESSING
	MOV	R1,-(SP)	;SAVE THE DEVICE MNEMONIC FOR LATER
	MOV	T.UCB(R5),R1	;GET THE UCB ADDRESS FOR THIS TASK
	CALL	$GTUSR		;GET THE USER LOGICAL HASH TABLE ADDRESS
	MOV	(SP)+,R2	;RESTORE THE DEVICE MNEMONIC
	CALL	$LNTD1		;DO RECURSIVE LOOKUP FOR DEVICE
	BCC	45$		;IF CC, SUCCESSFUL LOOKUP
	TST	R3		;SEE IF NO LOGICAL OR ERROR
	BNE	40$		;IF NE, BAD LOGICAL OR RECURSION LIMIT ERROR
	BR	50$		;NO LOGICAL EXISTS
45$:	MOV	KISAR6,-(SP)	;SAVE APR6 MAPPING FOR A MOMENT
	MOV	R3,KISAR6	;MAP THE LNB
	MOVB	MAP6+L.NTBL,$TEMP0 ;SAVE THE TABLE NUMBER FOR THE OUTPUT BUFFER
	MOV	(SP)+,KISAR6	;RESTORE APR6 MAPPING
	INC	2(SP)		;INDICATE AN ASSIGNMENT WAS FOLLOWED
	BR	55$		;GO FIND UCB IN PHYSICAL TABLES

	.IFF	;DF L$$GCL

	MOV	#$LOGHD,R2	;GET LOGICAL ASSIGNMENT LIST LISTHEAD
20$:	MOV	(R2),R2		;POINT TO NEXT LOGICAL ASSIGNMENT BLOCK
	BEQ	50$		;IF EQ, END OF LIST
	MOVB	L.TYPE(R2),$TEMP0 ;IS THIS A GLOBAL ASSIGNMENT?
				;SAVE TYPE TO RETURN TO USER LATER.
				;(NOTE, L.TYPE MUST BE USED IN
				;CONJUNCTION WITH THE "GI.ATT" STATUS
				;BIT SINCE L.TYPE IS ZERO FOR GLOBAL
				;ASSIGNMENTS.)
	BEQ	30$		;IF EQ YES, DO NOT CHECK L.UCB
	CMP	L.UCB(R2),T.UCB(R5) ;VALID ASSIGNMENT FOR TASK'S TI:?
	BNE	20$		;IF NE NO
30$:	CMP	R1,L.NAM(R2)	;DEVICE NAME MATCH?
	BNE	20$		;IF NE NO
	CMPB	R0,L.UNIT(R2)	;UNIT NUMBER MATCH?
	BNE	20$		;IF NE NO
	MOV	L.ASG(R2),R1	;GET ASSIGNMENT UCB ADDRESS

	ASSUME	GI.ASN,1

	INC	(SP)		;INDICATE AN ASSIGNMENT WAS FOLLOWED
	BR	70$		;GO FINISH RESOLVING DEVICE NAME

	.IFTF	;DF L$$GCL

40$:
	.IF DF C$$RMT		; REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	; REMOTE TASK SUPPORT TURNED ON?
	BEQ	48$		; IF EQ NO

	RETURN			; KX DRIVER HAS ALREADY RETURNED STATUS
48$:
	.ENDC

	DRSTS	D.RS92		; RETURN INVALID DEVICE ERROR

;
; AT THIS POINT, WE MUST CHECK THE SYSTEM DEVICE TABLES FOR THE
; A DEVICE WITH THE NAME SPECIFIED IN THE DPB SINCE FOR ONE REASON
; OR ANOTHER THE SCAN OF THE LOGICAL ASSIGNMENTS CAME UP EMPTY.
; A CALL TO $CVDVN WILL NOT FUNCTION CORRECTLY AT THIS POINT SINCE
; PSEUDO DEVICES ARE IGNORED BY THE $SCDVT ROUTINE.
;

50$:	CLR	$TEMP0		;INIT WORD CONTAINING ASSIGNMENT TYPE
				;SINCE WE EITHER COULDN'T FIND ONE OR
55$:
	.IFT	;DF L$$GCL

	MOV	R2,R1		;RESTORE DEVICE MNEMONIC FOR PHYSICAL SCAN
	MOV	(SP)+,R3	;RESTORE THE OUTPUT BUFFER ADDRESS

	.ENDC	;DF L$$GCL

57$:	MOV	#$DEVHD,R2	;GET DCB LISTHEAD
				;(PHYSICAL SYSTEM DEVICE TABLE)
60$:	MOV	(R2),R2		;GET NEXT DCB
	BEQ	40$		;IF EQ, DEVICE IS NOT IN SYSTEM
	CMP	R1,D.NAM(R2)	;DEVICE NAME MATCH?
	BNE	60$		;IF NE NO
	CMPB	R0,D.UNIT(R2)	;IS THIS THE DCB FOR THE SPECIFIED UNIT?
	BLO	60$		;IF LO NO
	CMPB	R0,D.UNIT+1(R2)	;REALLY?
	BHI	60$		;IF HI NO
	SUB	D.UNIT(R2),R0	;CONVERT TO RELATIVE UNIT NUMBER
	BIC	#177400,R0	;CLEAR MUNGED HIGH BYTE
	MOV	D.UCBL(R2),R1	;GET LENGTH OF UCB IN BYTES
	CALL	$MUL		;CALCULATE OFFSET FOR DESIRED UCB
	ADD	D.UCB(R2),R1	;CALCUALTE ADDRESS OF UCB
;
; AT THIS POINT, WE'VE FOUND A RAW UCB. THAT IS TO SAY, THE REDIRECTS
; HAVE NOT BEEN FOLLOWED AND THE VIRTUAL TERMINAL CHECK HAS NOT BEEN
; PERFORMED. ONLY THE PARENT OR OFFSPRING TASK OF A GIVEN VT UNIT
; MAY RETRIEVE INFO ON THE UNIT SINCE THEIR EXISTENCE IS ACCOUNTED
; FOR IN THE VT USE COUNT.
;
; CURRENTLY:
;		R1 = RAW UCB ADDRESS
;		R3 = POINTER TO USER BUFFER
;		R5 = TCB ADDRESS OF ISSUING TASK (ALSO CURRENT)
;		2(SP) = EXTRA WORD COUNT
;		 (SP) = SCRATCH STATUS WORD
;
70$:

	.IF DF	V$$TRM


	ASSUME	U.DCB,0		;ASSUME THAT THE FIRST WORD OF THE UCB
				;IS THE POINTER TO THE DCB
	MOV	(R1),R2		;POINT TO UNIT'S DCB
	CMP	D.NAM(R2),#"VT	;IS THE DEVICE A VIRTUAL TERMINAL?
	BNE	80$		;IF NE NO
	CMP	U.PTCB(R1),R5	;IS ISSUING TASK THE PARENT?
	BEQ	80$		;IF EQ YES
	CMP	R1,T.UCB(R5)	;IS ISSUING TASK AN OFFSPRING?
	BNE	40$		;IF NE NO, RETURN ERROR


	.ENDC	;V$$TRM


80$:	MOV	R1,R0		;COPY RAW UCB ADDRESS
	CALL	$MPLND		;MAP TO REAL UCB ADDRESS
	CMP	R1,R0		;WAS UNIT REDIRECTED?
	BEQ	90$		;IF EQ, NO
	BIS	#GI.RED,(SP)	;REMEMBER UNIT WAS REDIRECTED

90$:
;
; THE GET DEVICE INFORMATION AND SON OF GET DEVICE INFORMATION SUBFUNCTIONS
; DIVERGE AT THIS POINT.
;
	CMPB	#6,R4			; IS IT "GET DEVICE INFORMATION"?
	BEQ	91$			; YES, CONTINUE.
	JMP	$SFDVJ			; NO, USE THE JUNIOR VERSION.
91$:
;
; NOW THAT WE HAVE A "REAL" UCB ADDRESS, THE DEVICE STATUS
; RETURNED IN "G.IDEV" IS DETERMINED.  ALONG THE WAY, THE USER'S
; VARIABLE LENGTH BUFFER IS FILLED IN WHEN NEEDED AND IF POSSIBLE.
;
	MOVB	U.STS(R0),(R3)+	; PLACE U.STS IN USER BUFFER
	MOVB	U.ST2(R0),R1	;
	MOVB	R1,(R3)+	;PLACE U.ST2 IN USER BUFFER
	BIC	#CLRMSK,-(R3)	;CLEAR OUT UNNEEDED BITS
	SWAB	R1		;MOV US.OFL INTO HIGH BIT OF
	ROR	R1		;LOW ORDER BYTE
	BIC	#^C<200>,R1	;CLEAR ALL BUT 'GI.OFL'
	BIS	R1,(R3)		;'OR' IN UNIT OFFLINE STATUS
	BIS	(SP)+,(R3)	;'OR' IN ASSIGNMENT AND REDIRECT INFO
	MOV	(SP)+,R4	;RETRIEVE EXTRA WORD COUNT
	MOV	U.CW1(R0),R1	;GET U.CW1 FOR USER BUFFER
	MOV	R1,-(SP)	;AND SAVE IT AS WELL FOR LATER
	MOV	R5,-(SP)	;SAVE ISSUER'S TCB ADDRESS
	MOV	R3,R5		;COPY TOP OF USER BUFFER ADDRESS
	TST	(R3)+		;POINT TO START OF OPTIONAL WORDS
	CALL	XMIT		;COPY U.CW1 TO USER BUFFER
	MOV	U.PRM(R0),R1	;DITTO FOR U.PRM
	CALL	XMIT		;
	MOV	U.PRM+2(R0),R1	;DITTO FOR U.PRM+2
	CALL	XMIT		;
	MOV	R0,R1		;RETURN 'TARGET' DEVICE NAME
100$:	CALL	DNFILL		;
	BCS	110$		;IF CS, NO USER BUFFER ROOM TO RETURN
				;L.TYPE INFO
	MOVB	$TEMP0,-1(R3)	;RETURN ASSIGNMENT INFO
110$:	MOV	U.ATT(R0),R1	;IS DEVICE ATTACHED?
	BEQ	120$		;IF EQ NO
	BIS	#GI.ATT,(R5)	;TELL ISSUER
	CMP	R1,(SP)		;IS IT THE ISSUER WHO IS ATTACHED?
	BNE	120$		; NO, DO NOT SET BIT.
	BIS	#GI.ATU,(R5)	;RETURN THIS STATUS AS WELL
120$:	CALL	TNFILL		;RETURN TASK NAME OF ATTACHEE
	MOV	(SP)+,R2	;GET ISSUER'S TCB
	MOV	U.OWN(R0),R1	;IS DEVICE ALLOCATED?
	BEQ	130$		;IF EQ NO
	BIS	#GI.ALL,(R5)	;RETURN STATUS
	CMP	T.UCB(R2),R1	;IS ALLOCATOR THE ISSUER'S TI:?
	BNE	130$		;IF NE NO
	BIS	#GI.ALU,(R5)	;RETURN THIS STATUS AS WELL
130$:	CALL	DNFILL		;RETURN DEVICE NAME OF ALLOCATOR
	MOV	U.SCB(R0),R1	;VIA THE SCB..
	MOV	S.KRB(R1),R1	;GET THE DEVICE'S KRB
	BEQ	140$		;IF EQ, CANN'T DETERMINE CONTROLLER
				;STATUS.
	BIT	#KS.OFL!KS.PDF,K.STS(R1) ;IS THE CONTROLLER OFFLINE
				;OR PDF?
	BEQ	140$		;IF EQ NO
	BIS	#GI.OFL!GI.COF,(R5) ;TELL USER
140$:	MOV	U.DCB(R0),R1	;CHECK IF DRIVER LOADED?
	TST	D.DSP(R1)	;LOADED?
	BNE	150$		;IF NE YES
	BIS	#GI.UNL,(R5)	;RETURN STATUS
	BR	190$		;NOTHING MORE TO RETURN..EXIT
150$:	COM	(SP)		;COMPLEMENT SAVED U.CW1
	BIT	#DV.MNT!DV.MSD,(SP) ;MASS STORAGE AND MOUNTABLE DEVICE?
	BNE	190$		;IF NE NO
	BITB	#US.MNT,U.STS(R0) ;DEVICE MOUNTED?
	BNE	190$		;IF NE NO
	MOV	U.VCB(R0),R2	;GET DEVICE VCB
	BEQ	190$		;BAIL OUT..CAN'T TOUCH U.ACP TILL VCB
				;SET UP
	MOV	U.ACP(R0),R1	;GET TCB ADDRESS OF ACP
	CALL	TNFILL		;SO ACP NAME CAN BE RETURNED TO USER
	BIT	#DV.SQD,(SP)	;IS DEVICE AN ANSI LABLED MAGTAPE?
	BNE	155$		;IF NE NO (COPY OF U.CW1 IS COMPLEMENTED
				;ON STACK)
	BITB	#US.LAB,U.STS(R0) ;IS IT "LABLED"
	BEQ	155$		;IF EQ NO
	BIS	#GI.LAB,(R5)	;RETURN STATUS
155$:	CMP	R4,#<G.IEND-G.IVOL>/2 ;USER BUFFER BIG ENOUGH FOR LABLE?
	BLT	190$		;IF LT NO
	ADD	#V.LABL,R2	;POINT TO LABLE
	MOV	(R2)+,(R3)+	;COPY FIRST SIX BYTES OF LABLE
	MOV	(R2)+,(R3)+	;
	MOV	(R2)+,(R3)+	;
	BIT	#GI.LAB,(R5)	;IS IT A LABLED ANSI TAPE?
	BEQ	180$		;IF EQ NO
	MOV	V.MVL(R0),R1	;POINT TO FIRST MOUNTED VOL. LIST ENTRY
	BEQ	180$		;IF EQ THERE ISN'T ONE,JUST RETURN LABEL
160$:	CMP	M.UCB(R1),R0	;DEVICE UCB MATCH WITH THIS ENTRY?
	BEQ	170$		;IF EQ YES
	MOV	M.NXT(R1),R1	;GET NEXT LIST ENTRY
	BNE	160$		;CONTINUE SCAN
	BR	180$		;ELSE AT END OF LIST..JUST RETURN LABLE
170$:	MOV	R1,R2		;COMPUTE ADDRESS OF VOLUME ID
	ADD	#M.VIDP,R2	;
180$:	MOV	(R2)+,(R3)+	;FINISH RETURNING VOLUME LABLE
	MOV	(R2)+,(R3)+	;OR VOLUME ID
	MOV	(R2)+,(R3)+	;
190$:	TST	(SP)+		;CLEAN STACK
	
	.IF DF C$$RMT		; IF REMOTE TASKS

	BIC	#1,$UMPS	; CLEAR USER CARRY BIT
	MOV	#IS.SUC,-(SP)	; PUT SUCCESS STATUS ON STACK
	MTPD$	@#H.DSW		; PUT STATUS IN DIRECTIVE STATUS WORD

	.ENDC	; C$$RMT

	RETURN			;ALL DONE..RETURN

	.ENABLE	LSB


TNFILL:	TST	R1		;WAS A TCB ADDRESS SPECIFIED?
	BEQ	20$		;IF EQ NO..GO ADJUST POINTERS
	MOV	T.NAM+2(R1),-(SP) ;GET SECOND HALF OF NAME
	MOV	T.NAM(R1),R1	;AND FIRST HALF
	BR	10$		;
DNFILL:
	TST	R1		;WAS A UCB ADDRESS SPECIFIED?
	BEQ	20$		;IF EQ NO.GO ADJUST POINTERS
	MOV	U.DCB(R1),R2	;GET DCB
	TST	(R2)+		;SKIP LINK WORD
	SUB	(R2)+,R1	;CALCULATE OFFSET INTO CONTIGUOUS UCBS
	MOV	(R2)+,-(SP)	;GET DEVICE NAME
	MOV	(R2)+,-(SP)	;GET LOW LOGICAL UNIT NUMBER
	MOV	(R2)+,R2	;GET UCB SIZE
5$:	SUB	R2,R1		;DETERMINE LOGICAL UNIT NUMBER
	BMI	6$		;
	INC	(SP)		;
	BR	5$		;
6$:	MOV	2(SP),R1	;GET DEVICE NAME
	MOV	(SP)+,(SP)	;CLEAN UP STACK
	BIC	#^C<377>,(SP)	;CLEAR OUT HIGH ORDER GARBAGE BYTE
10$:	CALL	XMIT		;FILL IN A WORD IN USER BUFFER
	MOV	(SP)+,R1	;GET NEXT WORD
XMIT:	CLC			;ASSUME SUCCESS
	DEC	R4		;ENOUGH ROOM IN USER BUFFER?
	BMI	40$		;IF MI NO
	MOV	R1,(R3)+	;RETURN WORD TO USER BUFFER
	BR	30$		;EXIT GRACEFULLY
20$:	SUB	#2,R4		;ADJUST WORD COUNT
	BMI	40$		;IF MI WE'RE AT THE END OF BUFFER
	ADD	#4,R3		;ADJUST POINTER
30$:	TST	(PC)+		;RETURN SUCCESS
40$:	SEC			;RETURN ERROR STATUS
	RETURN			;

	.DSABL	LSB





;+
; **-$SFDVJ-SON OF GET DEVICE INFORMATION
;
;	THIS GIN SUBFUNCTION RETURNS INFORMATION ABOUT A PARTICULAR
;	DEVICE.  THE DPB AND METHOD OF DETERMINING THE DEVICE TO BE
;	EXAMINED ARE IDENTICAL TO THE GET DEVICE INFORMATION
;	SUBFUNCTION, EXCEPT THAT THE SUBFUNCTION IS 18 RATHER THAN 6.
;
;	THE CURRENT MINIMUM AND MAXIMUM BUFFER LENGTH IS ONE.
;
; INPUT AT THIS POINT (AFTER COMMON PROCESSING IN $SFDEV) IS:
;
;	R1 -- UCB OF DEVICE TO BE CHECKED
;	R3 -- POINTER TO USER'S BUFFER
;	R5 -- POINTER TO ISSUING TASK'S TCB
;	STACK -- TWO UNNEEDED WORDS ARE ON THE STACK (ALONG WITH
;		THE RETURN ADDRESS AND REMAINING INFORMATION).
;
; OUTPUT IN THE USER BUFFER IS:
;
;	FIRST WORD:
;		NEGATIVE -- CODE INDICATING WHY DEVICE CANNOT CURRENTLY
;			BE ACCESSED AS A MOUNTED DEVICE.
;		NON-NEGATIVE -- BITS DESCRIBING ACCESS TO MOUNTED DEVICE:
;			BITS 0 TO 3:  WHICH TYPES OF ACCESS ARE
;				PROHIBITED (R, W, E, D, LOW TO HIGH),
;			BIT 4:  DEVICE IS PUBLIC,
;			BIT 5:  DEVICE IS ALLOCATED TO ISSUER,
;			BIT 6:  DEVICE IS FOREIGN, AND
;			BIT 7:  THE FOREIGN DEVICE HAS AN ACP.
;			NOTE THAT BITS 4 AND 5 OFF TOGETHER INDICATE
;			THE DEVICE IS MOUNTED BY THE ISSUER, BUT NOT
;			ALLOCATED OR PUBLIC.
;-

; DEFINE PROTECTION BITS.
R	=	000001		; READ
W	=	000002		; WRITE
C	=	000004		; CREATE
D	=	000010		; DELETE
; DEFINE OTHER BITS.
GJ.PUB	=	000020		; DEVICE IS PUBLIC.
GJ.ALL	=	000040		; DEVICE IS PRIVATE (ALLOCATED).
GJ.FOR	=	000100		; DEVICE IS FOREIGN.
GJ.ACP	=	000200		; FOREIGN DEVICE HAS ACP.
; DEFINE OTHER CODES.
GJ.NMM	=	-1		; DEVICE IS NOT BOTH MASS-STORAGE AND MOUNTABLE.
GJ.NMO	=	-2		; DEVICE IS NOT MOUNTED FOR ISSUER.
	
$SFDVJ:
	MOV	R0,R1			; PUT UCB IN PREFERRED REGISTER.
	CMP	(SP)+,(SP)+		; POP UNNEEDED BITS AND WORD COUNT.
	MOV	U.CW1(R1),R0		; GET FIRST CHARACTERISTICS WORD.
	COM	R0			; REVERSE SENSE OF BITS.
	BIT	#DV.MNT!DV.MSD,R0	; IS IT NOT MASS STORAGE OR NOT
					; MOUNTABLE?
	BNE	90$			; YES, RETURN CODE.
	BITB	#US.MNT,U.STS(R1)	; IS DEVICE NOT MOUNTED?
	BNE	95$			; YES, THERE IS NO ACCESS.
	MOV	#GJ.PUB,(R3)		; ASSUME PUBLIC UNTIL PROVEN OTHERWISE.
	BITB	#US.PUB,U.ST2(R1)	; IS DEVICE PUBLIC?
	BNE	20$			; YES, SKIP REST OF MOUNT CHECKS.
	MOV	#GJ.ALL,(R3)		; ASSUME PRIVATE UNTIL PROVEN OTHERWISE.
	MOV	T.UCB(R5),R0		; GET ISSUER'S TI: UCB ADDRESS.
	CMP	U.OWN(R1),R0		; DOES ISSUER HAVE IT ALLOCATED?
	BEQ	20$			; YES, IT IS MOUNTED FOR USER.
	TST	U.OWN(R1)		; IS DEVICE ALLOCATED?
	BNE	95$			; YES, DEVICE IS NOT MOUNTED FOR USER.
	CLR	(R3)			; IT MUST BE SEMI-PRIVATE.
	BIT	#T3.PRV,T.ST3(R5)	; IS ISSUER PRIVILEGED?
	BNE	20$			; YES, IT IS MOUNTED FOR USER.
	MOV	#$MOULS,R2		; GET START OF MOUNT LIST.
10$:
	MOV	(R2),R2			; GET NEXT ENTRY.
	BEQ	95$			; DEVICE IS NOT MOUNTED FOR USER.
	CMPB	#MT.MLS,M.TYPE(R2)	; CORRECT TYPE OF ENTRY?
	BNE	10$			; NO, GO ON TO NEXT.
	CMP	M.DEV(R2),R1		; IS IT THE DEVICE WE ARE LOOKING FOR?
	BNE	10$			; NO, GO ON.
	CMP	M.TI(R2),R0		; IS THIS ENTRY FOR OUR ISSUER?
	BNE	10$			; NO, GO ON.
; DEVICE IS MOUNTED FOR THIS USER.
20$:
	BITB	#US.FOR,U.STS(R1)	; IS DEVICE MOUNTED FOREIGN?
	BEQ	100$			; NO, HANDLE FILES-11 DEVICE.
	BIS	#GJ.FOR,(R3)		; YES, REPORT THAT TO USER.
	TST	U.ACP(R1)		; IS THERE AN ACP?
	BEQ	80$			; NO, LEAVE.
	BIS	#GJ.ACP,(R3)		; YES, REPORT THAT.
80$:
	BR	99$			; RETURN WITH STATUS
90$:	
	MOV	#GJ.NMM,(R3)		; INDICATE DEVICE IS NOT MOUNTABLE.
	BR	99$			; RETURN WITH STATUS
95$:
	MOV	#GJ.NMO,(R3)		; INDICATE DEVICE IS NOT MOUNTED FOR
99$:	
	.IF DF C$$RMT			; IF REMOTE TASKS

	BIC	#1,$UMPS		; CLEAR USER CARRY BIT
	MOV	#IS.SUC,-(SP)		; PUT SUCCESS STATUS ON STACK
	MTPD$	@#H.DSW			; PUT STATUS IN DIRECTIVE STATUS WORD

	.ENDC	; C$$RMT
					; USER.
	RETURN
100$:
	BIT	#T3.PRV,T.ST3(R5)	; IS ISSUER PRIVILEGED?
	BNE	190$			; YES, THEY CAN DO ALMOST ANYTHING.
	MOV	KISAR6,-(SP)		; SAVE APR.
	MOV	$SAHDB,KISAR6		; MAP HEADER.
	MOV	$SAHPT,R2		; GET ADDRESS OF HEADER.
	MOV	H.DUIC(R2),R0		; GET DEFAULT UIC.
	MOV	H.CUIC(R2),R2		; GET CURRENT (PROTECTION) UIC.
	MOV	(SP)+,KISAR6		; RESTORE APR.
	CLR	-(SP)			; ASSUME NO SYSTEM ACCESS.
	CMP	R2,#10*400+377		; IS ISSUER IN A SYSTEM GROUP?
	BHI	120$			; NO, DO NOT GIVE THEM SYSTEM ACCESS.
	INC	(SP)			; FLAG SYSTEM ACCESS.
120$:
	MOV	U.VCB(R1),R4		; GET LOCATION OF VOLUME CONTROL BLOCK.
	BIT	#FE.MUP,$FMASK		; IS THIS A MULTI-USER PROTECTION
					; SYSTEM?
	BEQ	140$			; NO, SKIP USER CHECKS.
	CMP	T.UCB(R5),U.OWN(R1)	; DOES ISSUER OWN THIS DEVICE?
	BEQ	130$			; YES, GIVE THEM SYSTEM ACCESS.
	TST	(SP)			; SYSTEM GROUP?
	BNE	140$			; YES, SKIP VOLUME OWNER CHECK.
	CMP	T.UCB(R5),V.VOWN(R4)	; DOES ISSUER OWN VOLUME?
	BNE	140$			; NO, DO NOT GRANT SYSTEM ACCESS.
130$:
	INC	(SP)			; THIS ISSUER HAS SYSTEM ACCESS.
	MOV	R0,R2			; USE DEFAULT UIC.
140$:
	SWAB	R2			; REFORMAT UIC.
	MOV	V.VOWN(R4),R0		; GET VOLUME OWNER.
	MOV	V.VPRO(R4),R4		; GET VOLUME PROTECTION.
	SWAB	R0			; REFORMAT UIC.
	COM	R4			; CHANGE SENSE OF BITS.
	TSTB	(SP)+			; DOES ISSUER HAVE SYSTEM ACCESS?
	BNE	150$			; YES, DO NOT REFUSE SYSTEM ACCESS.
	CMPB	R2,#10			; DOES ISSUER HAVE SYSTEM ACCESS?
	BLOS	150$			; YES, DO NOT REFUSE SYSTEM ACCESS.
	BIC	#R!W!C!D,R4		; ELIMINATE SYSTEM ACCESS RIGHTS.
150$:
	CMP	R2,R0			; IS ISSUER OWNER?
	BEQ	160$			; YES, DO NOT REFUSE OWNER ACCESS.
	BIC	#<R!W!C!D>*20,R4	; ELIMINATE OWNER ACCESS RIGHTS.
160$:
	CMPB	R0,R2			; IS ISSUER IN OWNER'S GROUP?
	BEQ	170$			; YES, DO NOT REFUSE GROUP ACCESS.
	BIC	#<R!W!C!D>*400,R4	; ELIMINATE GROUP ACCESS RIGHTS.
170$:
	MOV	R4,-(SP)		; COPY REMAINING BITS.
	SWAB	(SP)			; MOVE HIGH BYTE TO LOW BYTE.
	BIS	R4,(SP)			; MERGE HIGH AND LOW BYTES.
	MOV	(SP),R4			; COPY RESULT.
	ASR	R4			; MOVE HIGH NYBBLE TO LOW NYBBLE.
	ASR	R4			;
	ASR	R4			;
	ASR	R4			;
	BIS	(SP)+,R4		; MERGE HIGH AND LOW NYBBLES.
	COM	R4			; RESTORE ORIGINAL SENSE.
	BIC	#^C<R!W!C!D>,R4		; GET RID OF EXTRANEOUS BITS.
	BR	200$
190$:
	CLR	R4			; GIVE ISSUER EVERYTHING.
200$:
	BIT	#DV.SWL,U.CW1(R1)	; DEVICE WRITE-LOCKED?
	BEQ	210$			; NO, LEAVE BITS ALONE.
	BIS	#W!C!D,R4		; ONLY READ ACCESS IS ALLOWED.
210$:
	BIS	R4,(R3)			; PASS DENIED ACCESSES TO USER.
	JMP	99$			; RETURN WITH STATUS

	

;+
; **-$SFAPR-GET TASK APRS
;
; THIS SUBFUNCTION FILLS A 97. WORD BUFFER WITH THE CONTENTS OF THE
; PARS/PDRS FOR ALL THE SPACES. THE FIRST WORD INDICATES WHICH OF THE
; SUBSEQUENT WORDS ARE FILLED IN.
;
;	SPACE				WORD 0. BIT
;	-----------------------		-----------
;
;	KERNEL  I  SPACE  PAR'S		(UNCONDITIONAL)
;	KERNEL  I  SPACE  PDR'S		(UNCONDITIONAL)
;	KERNEL  D  SPACE  PAR'S		(000001)
;	KERNEL  D  SPACE  PDR'S		(000001)
;	USER    I  SPACE  PAR'S		(UNCONDITIONAL)
;	USER    I  SPACE  PDR'S		(UNCONDITIONAL)
;	USER    D  SPACE  PAR'S		(000002)
;	USER    D  SPACE  PDR'S		(000002)
;	SUPER   I  SPACE  PAR'S		(000004)
;	SUPER   I  SPACE  PDR'S		(000004)
;	SUPER   D  SPACE  PAR'S		(000004)
;	SUPER   D  SPACE  PDR'S		(000004)
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(4.)
;	WD. 01 -- SUBFUNCTION CODE (9)
;	WD. 02 -- BUFFER ADDRESS
;	WD. 03 -- BUFFER SIZE IN WORDS
;
; INPUTS:
;
;	R3=ADDRESS OF FIRST WORD OF USER BUFFER
;	R5=TCB ADDRESS OF CURRENT TASK
;
; OUTPUTS:
;
;	THE BUFFER IS FILLED WITH THE APRS
;-

	MASK = 0
	.IIF DF K$$DAS, MASK=MASK!1
	.IIF DF U$$DAS, MASK=MASK!2
	.IIF DF S$$LIB, MASK=MASK!4

$SFAPR::MOV	#MASK,(R3)+	;INSERT MASK OF WHAT WILL FOLLOW
	MOV	#$APRTB,R0	;GET TABLE OF ADDRESSES
10$:	MOV	(R0)+,R1	;GET NEXT APR ADDRESS
	BEQ	20$		;IF EQ END OF LIST
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	MOV	(R1)+,(R3)+	;MOVE A REGISTER
	BR	10$		;GO AGAIN
20$:	RETURN			;

;+
; **-SFFTK-FIND TASK AND RETURN TASK INFO
;
;	THIS GIN FUNCTION RETURNS INFORMATION ON A TASK WHICH
; MAY HAVE ITS TCB IN SECONDARY OR PRIMARY POOL. GIVEN A TASKNAME,
; THIS GIN FUNCTION WILL ATTEMPT TO FIND A TASK AS DESCRIBED BELOW
; IN THE $SRTTK ROUTINE.
; 
; THE INFORMATION IS RETURNED TO A USER BUFFER HAVING A MINIMUM SIZE
; OF TWO WORDS AND A MAXIMUM SIZE OF SIX WORDS. THIS FUNCTION WILL
; RETURN AS MUCH OF THE FOLLOWING INFORMATION AS THE USER BUFFER'S SIZE
; ALLOWS FOR.
;
;
; DPB FORMAT:
;
;	+---------------+
;	|   6.	| 169.	|
;	+---------------+
;	|SUBFUNCTION=10.|
;	+---------------+
;	| BUFFER ADDRESS|
;	+---------------+
;	| BUFFER WDSIZE	|
;	+---------------+
;	|		|
;	+-  TASKNAME   -+
;	|		|
;	+---------------+
;
; USER BUFFER FORMAT:
;
;	+---------------+	|
;	|		|	|
;	+-  TASKNAME   -+	| THE FIRST TWO WORDS ARE REQUIRED.
;	|		|	|
;	+---------------+	|
;	|   T.STAT	|
;	+---------------+
;	|   T.ST2	|
;	+---------------+
;	|   T.ST3	|
;	+---------------+
;	|   T.ST4	|
;	+---------------+
;	|		|
;	+-  P.NAM      -+
;	|		|
;	+---------------+
;-

$SFFTK::MOV	R3,-(SP)	;SAVE ADDRESS OF USER BUFFER
	MOV	R2,-(SP)	;SAVE EXTRA WORD COUNT
	MOV	R4,R3		;COPY POINTER TO TASKNAME
	CALL	$SRTTK		;SEARCH FOR TCB
	BCS	30$		;IF CS TASK NOT INSTALLED
	MOV	KISAR6,-(SP)	;SAVE OLD KISAR6 MAPPING
	BIT	#1,R0		;IS TCB IN SECONDARY POOL?
	BEQ	5$		;IF EQ NO
	DEC	R0		;RESET FLAG
	MOV	(R0),KISAR6	;MAP TO TCB
	MOV	#140000,R0	;POINT AT IT
5$:	MOV	#$TNAME,R1	;POINT TO TEMP LOCATIONS IN SYSCM
	ADD	#T.NAM,R0	;POINT TO TASK NAME
	MOV	(R0)+,(R1)+	;COPY TASKNAME INTO TEMPORARY LOCATIONS
	MOV	(R0)+,(R1)+	;
	ADD	#T.STAT-<T.NAM+4>,R0 ;POINT TO T.STAT
	MOV	(R0)+,(R1)+	;COPY T.STAT
	MOV	(R0)+,(R1)+	;COPY T.ST2
	MOV	(R0),(R1)	;COPY T.ST3
	MOV	T.ST4-T.ST3(R0),R2 ;COPY T.ST4
	MOV	T.PCB-T.ST3(R0),R4 ;COPY T.PCB
	MOV	(SP)+,KISAR6	;RESTORE APR6 MAPPING ( USER BUFFER )
	MOV	(SP)+,R5	;RESTORE EXTRA WORD COUNT
	MOV	(SP)+,R3	;RESTORE POINTER TO USER BUFFER
	MOV	#$TNAME,R1	;POINT TO SAVED INFO
	MOV	(R1)+,(R3)+	;RETURN T.NAM
	MOV	(R1)+,(R3)+
	DEC	R5		;ROOM FOR MORE?
	BMI	20$		;IF MI NO
	MOV	(R1)+,(R3)+	;RETURN T.STAT
	DEC	R5		;ROOM FOR MORE?		
	BMI	20$		;IF MI NO
	MOV	(R1)+,(R3)+	;COPY T.ST2
	DEC	R5		;ROOM FOR MORE?		
	BMI	20$		;IF MI NO
	MOV	(R1)+,(R3)+	;COPY T.ST3
	DEC	R5		;ROOM FOR MORE?		
	BMI	20$		;IF MI NO
	MOV	R2,(R3)+	;COPY T.ST4
	CMP	R5,#2		;TWO MORE WORDS LEFT FOR P.NAM?
	BLT	20$		;IF LT NO
	MOV	P.NAM(R4),(R3)+	;COPY P.NAM
	MOV	P.NAM+2(R4),(R3)+
20$:	RETURN	
30$:	DRSTS	D.RS2		;RETURN DIRECTIVE ERROR OF IE.INS

;+
; **-$SRTTK-SEARCH FOR PROTOTYPE OR NON-PROTOTYPE OR MULTI-USER TASK TCB
;
; THIS ROUTINE SEARCHES FOR A TCB WHICH IS ASSOCIATED WITH THE TASKNAME
; AS FOLLOWS:
;
;	IF THE TASKNAME IS OF THE FORM "...XXX" THEN A CHECK IS MADE
;	 FOR THE MULTI-USER TASKNAME "XXXTNN" WHERE NN IS DERIVED FROM
;	 THE UCB ADDRESS PASSED IN R0. IF NOT FOUND THEN THE PROTOTYPE
;	 IS SEARCHED FOR.
;	IF THE TASKNAME IS OF THE FORM "XXX$$$" THEN A SEARCH IS MADE
;	 ONLY FOR THE PROTOTYPE AS A DIFFERENT FORM OF MULTI-USER
;	 TASKNAME EXISTS FOR DECNET PROTOTYPES SINCE THIS NAME IS NOT
;	 DERIVED FROM THE UCB ADDRESS.
;	IF THE TASKNAME IS OF NEITHER OF THE ABOVE FORMS, A SEARCH OF
;	 PRIMARY POOL IS MADE FOR A NON-PROTOTYPE TCB BEARING THE
;	 TASKNAME SPECIFIED.
;	IF THIS TASKNAME COULD NOT BE FOUND AND IT IS LIMITED TO THREE
;	 CHARACTERS THEN AN ADDITIONAL SEARCH IS MADE FOR A MULTI-USER
;	 TASK OR PROTOTYPE.
;
; INPUTS:
;
;	R3=ADDRESS OF TASK NAME TO SEARCH FOR.
;
; OUTPUTS:
;
;	C=1 IF TASK NAME OR THE PERMUTATIONS COULD NOT BE FOUND
;	C=0 IF SPECIFIED TASK IS FOUND
;		R3=ADDRESS OF TASKNAME FOUND
;		    (COULD BE DIFFERENT FROM INPUT)
;		R0=ADDRESS OF TCB IN POOL (IF EVEN)
;		R0=ADDRESS OF KISAR5 BIAS OF TCB (IF ODD)
; ASSUMPTIONS:
;
;	A MULTI-USER TASK NAME WILL BE DERIVED FROM THE UCB ADDRESS OF
;	THE TI: OF THE CURRENT TASK. IF THIS IS INAPPROPRIATE, USE THE
;	ALTERNATE ENTRY POINT $SRTSK AND SUPPLY THE CORRECT TI UCB
;	ADDRESS IN R0.
;-

$SRTTK::
	MOV	$TKTCB,R0	;GET CURRENT TASK'S
	MOV	T.UCB(R0),R0	;TI: UCB ADDRESS
$SRTSK::
	CMP	(R3)+,#^R...	;RSX PROTOTYPE NAME?
	BNE	50$		;IF NE NO
	TST	(R3)		;DOES 2ND HALF NAME HAVE NAME OF PROTO?
	BEQ	50$		;IF EQ NO
	MOV	(R3),R1		;PICK UP PROTOTYPE NAME
10$:	CALL	$SRMUT		;SEARCH FOR MULTI-USER TASK
	BCC	90$		;IF CC FOUND IT AS "XXXTnn"..SUCCESS
	MOV	(R3)+,(R3)	;TRY FOR PROTYPE..FORM NAME FROM $TNAME
	MOV	#^R...,-(R3)	;INTO "...XXX"
20$:	CALL	$SRPRO		;SEARCH SECONDARY AND PRIMARY POOL
	BR	90$		;ALL THAT CAN BE DONE HAS BEEN
50$:	CMP	(R3),#^R$$$	;2ND HALF OF NAME INDICATE DECNET
				;OR SPECIAL PROTOTYPE?
	BNE	60$		;IF NE NO
	MOV	-(R3),R1	;DOES DECNET PROTO HAVE A NAME
				;ALSO POINT TO BEGINNING OF TASK NAME
	BEQ	70$		;IF EQ NO NOT DECNET PROTOTYPE JUST A
				;"$$$" TASK
	BR	20$		;GO FIND IT
60$:	MOV	-(R3),R1	;POINT TO BEGINNING OF TASKNAME AND GET
				;FIRST HALF OF NAME FOR LATER IF NEEDED
70$:	MOV	R0,R2		;SAVE POSSIBLE TI: UCB POINTER
	CALL	$SRSTD		;SEARCH PRIMARY POOL FOR NON-PROTOTYPE
	BCC	90$		;IF CC FOUND IT .. RETURN SUCCESS
	MOV	R2,R0		;RESTORE UCB ADDRESS
	TST	2(R3)		;3 CHAR NAME ONLY?
	BEQ	10$		;IF EQ YES TREAT IT AS THE NAME OF A
				;PROTOTYPE
80$:	SEC			;COULDN'T FIND IT RETURN FAILURE
90$:	RETURN			;ALL DONE


	.IFTF ; DF R$$PRO

	.IF DF P$$3XX

;+
; **-$SFCFG-GET SYSTEM CONFIGURATION TABLE
;
; THIS DIRECTIVE RETURNS THE SYSTEM CONFIGURATION TABLE
; TO A USER BUFFER, TURNING IT UPSIDE DOWN IN THE PROCESS!
; THE TABLE IS VARIABLE LENGTH LOCATED AT THE HIGHEST AVAILABLE
; ADDRESS OF MEMORY DOWNWARDS. THE BYTE DESCRIBING THE SIZE OF THIS
; TABLE IS AT THE HIGHEST ADDRESS. THIS DIRECTIVE WILL RETURN AS
; MUCH OF THE TABLE THAT WILL FIT IN THE USER'S BUFFER
;
; DPB FORMAT:
;
;	WD 00 -- DIC(169.),DPB SIZE(4.)
;	WD 01 -- SUBFUNCTION CODE (12.)
;	WD 02 -- BUFFER ADDRESS
;	WD 03 -- BUFFER SIZE IN WORDS
;
; INPUTS:
;
;	R2 =NUMBER OF WORDS IN USER BUFFER-1
;	R3 =APR6 USER BUFFER ADDRESS
;
; OUPUTS:
;
;	THE USER'S BUFFER IS FILLED WITH THE REUESTED INFO
;	THE DSW CONTAINS THE NUMBER OF WORDS TRANSFERRED
;-

$SFCFG::
	INC	R2		;CORRECT WORD COUNT
	BIT	#H2.BRG,$HFMSK+2 ;IS THIS A PROFESSIONAL?
	BNE	NOTPRO		;IF NE NO
	MOV	#$PARHD,R0	;PICK UP MAIN PARTITION LISTHEAD
10$:	MOV	(R0),R0		;GET NEXT MAIN PARTITION
	BEQ	NOTPRO		;IF EQ COULDN'T FIND CNFTBL
	CMP	P.NAM(R0),#^RCNF ;IS THIS CNFTBL?
	BNE	10$		;IF NE NO
	CMP	P.NAM+2(R0),#^RTBL ;MAYBE
	BNE	10$		;IF NE NO TRY NEXT
	MOV	P.REL(R0),R1	;GET BASE OF PARTITION
	MOV	P.SIZE(R0),R0	;GET SIZE OF TABLE
	ASH	#5,R0		;CONVERT TO NUMBER OF WORDS
	CMP	R0,R2		;USER EXPECT MORE THAN WE CAN DELIVER?
	BHIS	20$		;IF HIS NO
	MOV	R0,R2		;SET WORD CNT TO CNFTBL PARTITION SIZE
20$:	ASL	R0		;CONVERT WD COUNT TO OFFSET
	ADD	#120000,R0	;ADD KISAR5 BIAS
	CMP	R0,#140000-64.	;COULD WE BLOW AWAY BIAS TO USER BUFFER
	BLOS	30$		;IF LOS NO
	DRSTS	D.RS99		;RETURN ERROR OF 'IE.SDP'
30$:	MOV	R2,2(SP)	;RETURN NUMBER OF WORDS TRANSFERRED
	CALLR	$FLIPM		;EXIT TO FLIP MOVE ROUTINE
NOTPRO:	DRSTS	D.RS92		;RETURN ERROR OF 'IE.IDU'


IDROM=173600
$SFSSN::
	BIT	#H2.BRG,$HFMSK+2 ;IS THIS A PROFESSIONAL
	BNE	NOTPRO		;IF NE NO
	MOV	#IDROM,R0	;GET ADDRESS OF ID PROM
	MOV	#6,R1		;SET UP LOOP COUNT TO TRANSFER 6 BYTES
	CLR	R2		;CLEAR VALIDITY FLAG
10$:	MOVB	(R0),(R3)+	;GET A BYTE OF SSN
	BIS	(R0),R2		;'OR' WITH FLAG TO DETECT A 0 IDVALUE
	ADD	#2,R0		;POINT TO NEXT BYTE OF SSN
	SOB	R1,10$		;LOOP TILL DONE
	TST	R2		;SSN ALL ZEROS?
	BEQ	NOTPRO		;IF EQ YES, IT COULDN'T HAVE BEEN A PRO
	RETURN			;RETURN SUCCESS


	.ENDC ; DF P$$3XX

	.IFF	; DF R$$PRO

;+
; **-$SFABO - ABORT ALL TASKS CURRENTLY ACTIVE ON A SPECIFIED TERMINAL
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO ABORT ALL TASKS THAT ARE CURRENTLY
; ACTIVE ON THE TERMINAL SPECIFIED IN THE DPB
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(4.).
;	WD. 01 -- SUBFUNCTION CODE (1) (LOW BYTE).
;	WD. 02 -- BUFFER ADDRESS.
;	WD. 03 -- BUFFER SIZE (IN WORDS).
;
; BUFFER FORMAT:
;
;	WD. 00 -- TERMINAL DEVICE NAME IN ASCII
;	WD. 01 -- OCTAL NUMBER OF TERMINAL 
;
; INPUTS:
;	
;	R2=NUMBER OF EXTRA WORDS IN USER BUFFER.
;	R3=ADDRESS OF WD. 00. OF THE BUFFER.
;	R5=TCB ADDRESS OF THE REQUESTING TASK.
;
; THIS ROUTINE WILL TRY TO ABORT ALL TASKS CURRENTLY RUNNING OR ABOUT TO 
; RUN ON A TERMINAL SPECIFIED BY THE ASCII NAME AND OCTAL UNIT NUMBER IN 
; THE BUFFER POINTED TO BY R3 IF THAT TASK HAS T3.MCR SET (IE. INITIATED
; BY MCR AT SOME POINT.  ALL OFFSPRING TASKS WILL ALSO BE ABORTED IF THEY CAN
; BE TRACED BACK TO THE EARLIEST PARENT TASK THAT HAS T3.MCR SET (IE. THE 
; OFFSPRING DOES NOT NEED TO HAVE IT SET TO BE ABORTED). A PROMPT PACKET IS 
; ISSUED FOR THE TERMINAL BECAUSE T3.MCR WILL BE CLEARED IN DREIF FOR ALL 
; TASKS THAT ARE ABORTED HERE.  SLAVED TASKS AND THOSE NOT MATCHING THE 
; SPECIFIED TI: WILL NOT BE ABORTED EVEN THOUGH THEY MAY HAVE PARENTS THAT 
; WILL BE.  PRIVILEGED TASKS WILL BE ABORTED IF THE TERMINAL IS PRIVILEGED.  
; IF IT IS NOT, A PRIVILEGED TASK WILL BE ABORTED ONLY IF IT HAS AN SREX STYLE
; ABORT AST.  TKTN WILL NOT BE CALLED FOR THE TASKS ABORTED.
;
; AN INITIAL PASS IS MADE TO SET T4.CTC FOR ANY TASK THAT HAS T3.MCR SET,
; DOES NOT HAVE A PARENT, AND MATCHES THE SPECIFIED TI:.  THAT TASK WILL 
; ALSO TRY TO BE ABORTED.  IF ANY TASKS ARE FOUND IN THIS INITIAL PASS THAT
; HAVE T4.CTC SET, ANOTHER PASS IS MADE THROUGH THE STD.  THIS TIME THE
; PARENTS OFF ALL TASKS ARE CHECKED TO SEE IF THEY HAVE T4.CTC SET.  IF SO,
; THE ORIGINAL (OFFSPRING) TASK ALSO HAS T4.CTC SET AND IS TRIED TO BE
; ABORTED. IF ANY OF THESE TASKS ARE FOUND, ANOTHER PASS THROUGH THE STD IS
; DONE.  EVENTUALLY NO TASKS WILL BE FOUND AND PROCESSING IS COMPLETED.
; THIS SCHEME ONLY REQUIRES 1 PASS IF NO TASKS CAN BE ABORTED; IT REQUIRES
; A MINIMUM OF 2 PASSES IF ANY TASKS MUST BE ABORTED AND MAY REQUIRE UP TO
; N PASSES WHERE N IS THE LONGEST LINKAGE OF ANY RELATIONSHIP CHAIN THAT
; DOESN'T WRAP AROUND ON ITSELF.
;
; (IS A PASS TO CLEAR T4.CTC FOR ANY TASK NOT ABORTED REQUIRED?)
;-

	.MCALL	ABODF$
	ABODF$

$SFABO::

	.IF DF	A$$CLI&C$$CTC

	BIT	#T3.PRV!T3.CLI,T.ST3(R5) ;IS TASK PRIVILEGED OR CLI?
	BNE	10$		;IF NE, YES
	DRSTS	D.RS16		;PRIVILEGE VIOLATION
10$:	MOV	(R3)+,R0	;GET ASCII NAME OF DEVICE
	MOV	(R3),R1		;GET OCTAL UNIT NUMBER
	CALL	$CVDVN		;CONVERT DEVICE NAME TO UCB ADDRESS
	BCC	20$		;IF CC, SUCCESSFUL
15$:	DRSTS	D.RS92		;INVALID DEVICE
20$:	BIT	#DV.TTY,U.CW1(R2);IS THIS DEVICE A TERMINAL
	BEQ	15$		;IF EQ, NO
	MOV	R2,-(SP)	;SAVE UCB ADDRESS ACROSS PROMPT CALL
	MOV	#CC.EXT!CC.TTD,R1 ;ISSUE TASK EXIT PROMPT (AND FORCE SNCMD)
25$:	CALL	$QCNTP		;ISSUE PROMPT REQUEST TO MCR
	MOV	(SP)+,R3	;RESTORE UCB ADDRESS
;
; FIRST PASS TO LOOK FOR TASKS WITH MATCHING TI:, T3.MCR SET, AND NOT SLAVED
;
	CLR	$DICSV		;CLEAR FLAG WORD FOR PROCESSED TASK
	MOV	$TSKHD,R1	;GET POINTER TO START OF STD
30$:	MOV	T.TCBL(R1),-(SP);STORE POINTER TO NEXT TASK IN STD
	BEQ	40$		;IF EQ, THIS IS NULL TASK
	TST	T.STAT(R1)	;IS TASK ACTIVE
	BMI	40$		;IF MI, NO, IGNORE
	BIT	#T3.CLI,T.ST3(R1);IS THIS A CLI TASK?
	BNE	40$		;IF NE, YES, SKIP THIS ONE
	CMP	R3,T.UCB(R1)	;DOES THE TASK MATCH THE UCB ADDRESS
	BNE	40$		;IF NE, NO, IGNORE
	BIT	#T3.SLV,T.ST3(R1);IS THIS TASK SLAVED?
	BNE	40$		;IF NE, YES, IGNORE
	BIT	#T3.MCR,T.ST3(R1);IS TASK ACTIVATED FROM TERMINAL?
	BEQ	40$		;IF EQ, NO, IGNORE THIS ONE
	INC	$DICSV		;INDICATE THAT WE'VE FOUND A TASK TO BE ABORTED
	BIS	#T4.CTC,T.ST4(R1);INDICATE THAT ANY OFFSPRING MUST GO
	CALL	ABORT		;ABORT THE TASK IF POSSIBLE
40$:	MOV	(SP)+,R1	;RESTORE STD LINK WORD
	BNE	30$		;IF NE, THERE ARE MORE TASKS IN THIS PASS
	TST	$DICSV		;CHECK IF ANY TASKS WERE PROCESSED
	BEQ	100$		;IF EQ, NO, SKIP ANY FURTHER PASSES
;
; NEXT SET OF PASSES WILL GET THE OFFSPRING OF THE TASKS RECOGNIZED ABOVE
;
50$:	CLR	$DICSV		;RESTORE THE TASK PROCESSED FLAG
	MOV	$TSKHD,R1	;GET POINTER TO START OF STD
55$:	MOV	T.TCBL(R1),-(SP);STORE POINTER TO NEXT TASK IN STD
	BEQ	80$		;IF EQ, THIS IS NULL TASK
	TST	T.STAT(R1)	;IS TASK ACTIVE
	BMI	80$		;IF MI, NO, IGNORE
	BIT	#T3.CLI,T.ST3(R1);IS THIS A CLI TASK?
	BNE	80$		;IF NE, YES, SKIP THIS ONE
	BIT	#T4.CTC,T.ST4(R1);IS TASK ALREADY PROCESSED
	BNE	80$		;IF NE, YES, IGNORE
	MOV	T.OCBH(R1),R4	;GET POINTER TO LISTHEAD OF PARENTS
	BEQ	80$		;IF EQ, ALREADY PROCESSED IN FIRST PASS, IGNORE
60$:	MOV	O.PTCB(R4),R5	;GET NEXT PARENT TCB ADDRESS IN OCB LIST
	BEQ	70$		;IF EQ, PARENT HAS EXITED, IGNORE
	BIT	#T4.CTC,T.ST4(R5) ;CHECK IF PARENT HAS BIT SET
	BEQ	70$		;IF EQ, NO, GO ON TO NEXT OCB
	INC	$DICSV		;INDICATE A TASK HAS BEEN PROCESSED
	BIS	#T4.CTC,T.ST4(R1) ;INDICATE THIS TASK IS PART OF CHAIN
	BR	75$		;GO TRY TO ABORT IT AS WELL
70$:	MOV	(R4),R4		;GET NEXT OCB ADDRESS
	BNE	60$		;IF NE, THERE ARE MORE
	BR	80$		;NO PARENT HAS T4.CTC SET, GO ON TO NEXT TCB
75$:	CMP	R3,T.UCB(R1)	;DOES THIS TASK MATCH THE SPECIFIED TI:
	BNE	80$		;IF NE, NO, DON'T ABORT, BUT MARK AS CHAIN
	BIT	#T3.SLV,T.ST3(R1);CHECK IF SLAVED
	BNE	80$		;IF NE, IT IS, DON'T ABORT BUT MARK AS CHAIN
	CALL	ABORT		;TRY TO ABORT THE TASK
80$:	MOV	(SP)+,R1	;RESTORE THE POINTER TO THE NEXT TCB
	BNE	55$		;IF NE, NO MORE TO DO THIS PASS
	TST	$DICSV		;CHECK IF ANOTHER PASS IS NECESSARY
	BNE	50$		;IF NE, YES
100$:

	.IFTF	;A$$CLI&C$$CTC

	RETURN

	.IFT	;A$$CLI&C$$CTC

;
; SUBROUTINE TO ATTEMPT TO ABORT A PARTICULAR TASK
; INPUTS:
;	R1 - TCB ADDRESS OF TASK TO BE ABORTED
;	R3 - UCB OF TI:
;
ABORT:	MOV	R3,-(SP)	;SAVE THE TI: UCB ACROSS CALL
	TSTB	T.ST2(R1)	;IS TASK EXITING?
	BMI	20$		;IF MI, NO, IGNORE
	MOV	#AB.CTC,R2	;SET UP THE DEFAULT SECONDARY ABORT CODE
	BIT	#U2.PRV,U.CW2(R3) ;IS ISSUING TERMINAL PRIVILEGED
	BNE	10$		;IF NE, YES, ANY TASK MAY BE ABORTED
	BIS	#AB.NPV,R2	;INDICATE TERM NONPRIV IN SECONDARY ABORT CODE
	BIT	#T3.PRV,T.ST3(R1);IS TASK TO BE ABORTED PRIVILEGED
	BEQ	10$		;IF EQ, NO, CAN BE ABORTED BY ANYONE
	MOV	R1,-(SP)	;SAVE THE CURRENT TCB POINTER
	MOV	R1,R5		;COPY THE TCB ADDRESS FOR CALL
	MOV	#AS.REA,R4	;GET EXIT AST CODE TO SEARCH IN LIST FOR
	CALL	$SRAST		;SEARCH FOR AST IN TCB LIST
	MOV	(SP)+,R1	;RESTORE THE TCB ADDRESS
	BCS	20$		;IF CS, NO AST AND TASK CAN'T BE ABORTED
	TSTB	A.NPR(R0)	;SEE IF THIS IS SREX AST
	BNE	10$		;IF NE, IT IS, TASK MAY BE ABORTED
	BIT	#T2.REX,T.ST2(R1);SEE IF ABORT AST BEING PROCESSED
	BEQ	20$		;IF EQ, NO, TASK CANNOT BE ABORTED
10$:	MOV	#S.CTKN,R0	;TELL DREIF THAT TKTN SHOULD NOT BE CALLED
	CALL	$ABTSK		;ABORT TASK SPECIFIED BY R1
20$:	MOV	(SP)+,R3	;RESTORE THE TI: UCB ACROSS CALL
	RETURN

	.ENDC	;A$$CLI&C$$CTC

	.ENDC	;R$$PRO


;+
; **-$SFPMN-SET PERFORMANCE MONITOR PARAMETERS
;
; THIS DIRECTIVE PASSES USER PARAMETERS P1 TO P8 IN THE DPB
; TO THE PERFORMANCE MONITOR USING THE SPM HOOKPOINT MECHANISM.
; SPM HOOKPOINTS ARE TURNED ON AND OFF ON THE FLY BY REPLACING 
; TWO INSTRUCTION WORDS WITH AN INSTRUCTION TO TRANSFER CONTROL TO SPM.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(10.)
;	WD. 01 -- SUBFUNCTION CODE (11.) (LOW BYTE).
;	WD. 02 -- PARAMETER #1
;	WD. 03 -- PARAMETER #2
;	WD. 04 -- PARAMETER #3
;	WD. 05 -- PARAMETER #4
;	WD. 06 -- PARAMETER #5
;	WD. 07 -- PARAMETER #6
;	WD. 08.-- PARAMETER #7
;	WD. 09.-- PARAMETER #8
;
; INPUTS:
;
;	R3=ADDRESS OF WD. 02 IN THE DPB
;	R5=TCB ADDRESS OF THE CURRENT TASK
;
; OUTPUTS:
;
;	THE 8. DPB PARAMETERS ARE PASSED TO THE PERFORMANCE MONITOR.
;
;-

 
 	.IF DF P$$MON

;+
;	** W A R N I N G **
;
;	SPM HOOKPOINT NUMBER 34.
;
;	DO NOT CHANGE THE INSTRUCTION FOLLOWING
;	LABEL WITHOUT CHECKING SPM
;-

$SPH34==.			;SPM CHANGES THE INSTRUCTION AT
				;THE LOCATION OF THIS LABEL

$SFPMN::
	NOP
	NOP
	RETURN			;
	.ENDC
 
;+
; **-$SFUPD-UPDATE UICS AND DEFAULT DIRECTORY 
;	ALTERNATE ENTRY POINT TO $SFUIC
;
; THIS DIRECTIVE TAKES THE DEFAULT UIC AND THE PROTECTION UIC FROM THE
; UCB OF THE TERMINAL (U.UIC AND U.LUIC) AND COPIES THEM INTO THE HEADER OF 
; THE TASK (H.DUIC AND H.CUIC RESPECTIVELY).  IT SETS THE DEFAULT DIRECTORY
; OF THE TASK TO BE THE SAME AS THE DEFAULT DIRECTORY OF THE TERMINAL, IF
; DIFFERENT.  IT THEN JUMPS TO $SFUIC.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(169.),DPB SIZE(4.).
;	WD. 01 -- SUBFUNCTION CODE (17.) (LOW BYTE).
;	WD. 02 -- BUFFER ADDRESS.
;	WD. 03 -- BUFFER SIZE (IN WORDS).
;
; BUFFER FORMAT:
;
;	DESCRIBED (AND FILLED IN) IN $SFUIC
;
; INPUTS:
;
;	R2 - NUMBER OF EXTRA WORDS IN THE USER BUFFER
;	R3 - ADDRESS OF WD. 00 IN THE BUFFER
;	R5 - ADDRESS OF THE TCB OF THE CURRENT TASK
;
; OUTPUTS:
; 
; THE UICS IN THE HEADER OF THE REQUESTING TASK ARE UPDATED.
; THE DEFAULT DIRECTORY STRING FOR THE TASK IS SET TO THAT OF THE TERMINAL.
;
;
;-
	.MCALL	LNMDF$
	LNMDF$

$SFUPD::
	.IF DF	X$$HDR

	MOV	KISAR6,-(SP)	;SAVE BUFFER MAPPING
	MOV	$SAHDB,KISAR6	;MAP TASK HEADER
	MOV	$SAHPT,R0	;GET TASK HEADER ADDRESS

	.IFF	;DF X$$HDR

	MOV	$HEADR,R0	;GET TASK HEADER ADDRESS
	
	.IFTF	; DF X$$HDR

	MOV	T.UCB(R5),R1		;GET TI: UCB
	MOV	U.UIC(R1),H.DUIC(R0) 	;MOVE DEFAULT UIC INTO HEADER
	MOV	U.LUIC(R1),H.CUIC(R0)	;MOVE PROTECTION UIC INTO HEADER
	
	.IFT	;DF X$$HDR

	MOV	(SP)+,KISAR6		;RESTORE BUFFER MAPPING

	.ENDC	;DF X$$HDR

; RESET DEFAULT DIRECTORY STRING

	.IF DF	N$$DIR		; NAMED DIRECTORY SUPPORT

	CMP	T.CTX(R5),U.CTX(R1) ;IS TERMINAL CONTEXT SAME AS TASK?
	BEQ	10$		;IF EQ, INDICATE SUCCESS
	MOV	T.CTX(R5),R1	;GET TERMINAL CONTEXT
	CALL	$DLCTX		;DELETE TASKS CURRENT CONTEXT
	MOV	T.UCB(R5),R1	;GET TI: UCB AGAIN
	MOV	U.CTX(R1),T.CTX(R5) ;SET TASK CONTEXT TO TERMINAL CONTEXT
	BEQ	10$		;IF EQ, DONE
	MOV	KISAR6,-(SP)	;SAVE MAPPING
	MOV	U.CTX(R1),KISAR6 ;MAP CONTEXT BLOCK
	INCB	C.REF+140000	;INCREMENT REFERENCE COUNT
	MOV	(SP)+,KISAR6	;RESTORE MAPPING

	.ENDC	;DF N$$DIR
	
10$:	JMP	$SFUIC		;FILL IN BUFFER WITH INFO


	.END